#!/bin/sh #### Patch script - GNU Emacs - version 19.16 to 19.17 #### This file contains patches to turn version 19.16 of GNU Emacs into #### 19.17. To apply them, cd to the top of the Emacs source tree, and #### then type 'sh '. ### 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.16/lisp ] ; then cd emacs-19.16 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.17.0"/' mv lisp/version.el lisp/version.el~ mv $$ lisp/version.el ### Put moves and renames here. rmdir lisp/forms-mode rm -f src/filelock.cpp.c mv lisp/hippie.el lisp/hippie-exp.el patch -p1 << \end-of-emacs-patch-kit diff -rc2P --exclude-from=exceptions emacs-19.16/ChangeLog emacs-19.17/ChangeLog *** emacs-19.16/ChangeLog Tue Jul 6 11:07:48 1993 --- emacs-19.17/ChangeLog Mon Jul 19 01:58:10 1993 *************** *** 1,2 **** --- 1,27 ---- + Sat Jul 17 19:53:06 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * Version 19.17 released. + + * Makefile.in (src/Makefile): Propagate C_SWITCH_SYSTEM to the src + directory's makefile. This allows the invocation of CPP which + builds xmakefile to receive these switches. The SunSoft C + preprocessor inserts spaces between tokens if it doesn't get the + -Xs flag requested in src/s/sol2.h. + + Mon Jul 12 14:43:38 1993 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) + + * configure.in (m68k-bull-sysv3): new config. + + Sat Jul 10 01:17:31 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * configure.in: Use the autoconf AC_FIND_X macro to try to find + the X Windows libraries. + + Wed Jul 7 05:57:15 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * make-dist (tempdir): Don't create lisp/forms-mode directory in + the distribution. Those files aren't kept in their own + subdirectory any more. + Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) diff -rc2P --exclude-from=exceptions emacs-19.16/GETTING.GNU.SOFTWARE emacs-19.17/GETTING.GNU.SOFTWARE *** emacs-19.16/GETTING.GNU.SOFTWARE Mon Jun 14 11:10:33 1993 --- emacs-19.17/GETTING.GNU.SOFTWARE Thu Jul 15 18:15:06 1993 *************** *** 89,92 **** --- 89,103 ---- `/pub/gnu/GNUinfo/DESCRIPTIONS'. + ** Where is the documentation? + + If documentation exists, it is inside each program's source code + distribution. Instructions on installing a program are often in files + name "README" and "INSTALL". Manuals and on-line documentations are + written in GNU's texinfo format and are found in files ending with + ".texi" or ".texinfo". Reference cards are usually written in TeX, + and TeX files end in ".tex". Unix style man pages only exist, when + volunteers supply them (the GNU Project finds the texinfo format to + be superior). Man page files usually end in a single digit. + * No Warranties diff -rc2P --exclude-from=exceptions emacs-19.16/Makefile.in emacs-19.17/Makefile.in *** emacs-19.16/Makefile.in Tue Jul 6 02:53:09 1993 --- emacs-19.17/Makefile.in Sun Jul 18 02:02:52 1993 *************** *** 283,286 **** --- 283,287 ---- -e 's|^LN_S *=.*$$|LN_S=${LN_S}|' \ -e 's|^CFLAGS *=.*$$|CFLAGS=${CFLAGS}|' \ + -e 's|^\(C_SWITCH_SYSTEM *=\).*$$|\1'"${C_SWITCH_SYSTEM}"'|' \ -e 's|^\(LD_SWITCH_X_SITE *=\).*$$|\1${LD_SWITCH_X_SITE}|' \ -e '/^# DIST: /d') > src/Makefile.tmp diff -rc2P --exclude-from=exceptions emacs-19.16/PROBLEMS emacs-19.17/PROBLEMS *** emacs-19.16/PROBLEMS Wed Jun 9 06:54:56 1993 --- emacs-19.17/PROBLEMS Fri Jul 16 13:49:38 1993 *************** *** 2,5 **** --- 2,34 ---- 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 + be because your X server has no key for the Alt modifier. The X + server that comes from MIT does not set up the Alt modifier by + default. + + If your keyboard has keys named Alt, you can enable them as follows: + + xmodmap -e 'add mod2 = Alt_L' + xmodmap -e 'add mod2 = Alt_R' + + If the keyboard has just one key named Alt, then only one of those + commands is needed. The modifier `mod2' is a reasonable choice if you + are using an unmodified MIT version of X. Otherwise, choose any + modifier bit not otherwise used. + + If your keyboard does not have keys named Alt, you can use some other + keys. Use the keysym command in xmodmap to turn a function key (or + some other 'spare' key) into Alt_L or into Alt_R, and then use the + commands show above to make them modifier keys. + * `Pid xxx killed due to text modification or page I/O error' diff -rc2P --exclude-from=exceptions emacs-19.16/README emacs-19.17/README *** emacs-19.16/README Tue Jul 6 12:34:36 1993 --- emacs-19.17/README Sun Jul 18 04:29:18 1993 *************** *** 1,4 **** ! This directory tree holds version 19.16 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. See the files `etc/NEWS' and `etc/news.texi' for information on new --- 1,12 ---- ! This directory tree holds version 19.17 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. + + Please note that version 19 of Emacs is still in beta-test. Although + you may well encounter bugs in this release, we encourage you to use + it, find the bugs, and report them; your bug reports are valuable + contributions to the FSF, since they allow us to notice and fix + problems on machines we don't have, or in code we don't use often. + See the "Bugs" node of the info tree for more information on how to + report bugs. See the files `etc/NEWS' and `etc/news.texi' for information on new diff -rc2P --exclude-from=exceptions emacs-19.16/config.guess emacs-19.17/config.guess *** emacs-19.16/config.guess Tue Jul 6 12:34:35 1993 --- emacs-19.17/config.guess Sun Jul 18 04:29:18 1993 *************** *** 41,47 **** echo alpha-dec-osf${UNAME_RELEASE} exit 0 ;; ! sun4*:SunOS:[5-9].*:*) ! echo sparc-sun-solaris2 exit 0 ;; sun4*:SunOS:*:*) echo sparc-sun-sunos${UNAME_RELEASE} --- 41,53 ---- echo alpha-dec-osf${UNAME_RELEASE} exit 0 ;; ! sun4*:SunOS:5.*:*) ! echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit 0 ;; sun4*:SunOS:*:*) echo sparc-sun-sunos${UNAME_RELEASE} *************** *** 77,80 **** --- 83,89 ---- echo rs6000-bull-bosx exit 0 ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 + exit 0 ;; 9000/31?:HP-UX:*:*) echo m68000-hp-hpux *************** *** 89,92 **** --- 98,107 ---- echo hppa1.0-hp-hpux exit 0 ;; + 9000/8??:4.3bsd:*:* | 9000/8?7:4.3bsd:*:* ) + echo hppa1.1-hp-bsd + exit 0 ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd + exit 0 ;; C1*:ConvexOS:*:*) echo c1-convex-bsd *************** *** 108,112 **** exit 0 ;; i[34]86:UNIX_SV:4.*:*) ! echo i486-unknown-sysv4 exit 0 ;; i[34]86:*:3.2:*) --- 123,131 ---- exit 0 ;; i[34]86:UNIX_SV:4.*:*) ! if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then ! echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE} ! else ! echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE} ! fi exit 0 ;; i[34]86:*:3.2:*) *************** *** 125,131 **** M680[234]0:*:R3V[567]*:*) test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; esac ! echo '(No uname command or uname output not recognized.)' 1>&2 #echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 --- 144,153 ---- M680[234]0:*:R3V[567]*:*) test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;; + 33??:*:4.0:*) + uname -p 2>/dev/null | grep 86 >/dev/null \ + && echo i486-ncr-sysv4 && exit 0 ;; esac ! #echo '(No uname command or uname output not recognized.)' 1>&2 #echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 *************** *** 144,147 **** --- 166,173 ---- #endif + #if defined(NeXT) + printf("m68k-next-bsd\n"); exit(0); + #endif + #if defined (MULTIMAX) || defined (n16) #if defined (UMAXV) *************** *** 160,163 **** --- 186,202 ---- #endif + #if defined(sequent) + #if defined(i386) + printf("i386-sequent-dynix\n"); exit(0); + #endif + #if defined (ns32000) + printf("ns32k-sequent-dynix\n"); exit(0); + #endif + #endif + + #if defined(_SEQUENT_) + printf("i386-sequent-ptx\n"); exit(0); + #endif + exit (1); } *************** *** 167,171 **** rm -f dummy.c dummy ! echo '(Unable to guess system type)' 1>&2 exit 1 --- 206,210 ---- rm -f dummy.c dummy ! #echo '(Unable to guess system type)' 1>&2 exit 1 diff -rc2P --exclude-from=exceptions emacs-19.16/config.sub emacs-19.17/config.sub *** emacs-19.16/config.sub Tue Jul 6 12:34:35 1993 --- emacs-19.17/config.sub Sun Jul 18 04:29:17 1993 *************** *** 369,375 **** os=-sysv3 ;; ! dpx2) basic_machine=m68k-bull ! os=-sysv ;; ebmon29k) --- 369,379 ---- os=-sysv3 ;; ! dpx2* | dpx2*-bull) basic_machine=m68k-bull ! os=-sysv3 ! ;; ! sps7) ! basic_machine=m68k-bull ! os=-sysv2 ;; ebmon29k) *************** *** 492,496 **** # Decode manufacturer-specific aliases for certain operating systems. ! if [ "$os" ] then case $os in --- 496,500 ---- # Decode manufacturer-specific aliases for certain operating systems. ! if [ x"$os" != x"" ] then case $os in *************** *** 498,501 **** --- 502,508 ---- -solaris1 | -solaris1.*) os=`echo $os | sed -e 's|solaris1|sunos4|'` + ;; + -solaris) + os=-solaris2 ;; # First accept the basic system types. diff -rc2P --exclude-from=exceptions emacs-19.16/configure emacs-19.17/configure *** emacs-19.16/configure Tue Jul 6 11:13:47 1993 --- emacs-19.17/configure Sun Jul 18 02:31:01 1993 *************** *** 442,447 **** ;; ## Bull sps7 ! m68*-bull-sysv* ) machine=sps7 opsys=usg5-2 ;; --- 442,452 ---- ;; + ## Bull dpx2 + m68*-bull-sysv3* ) + machine=dpx2 opsys=usg5-3 + ;; + ## Bull sps7 ! m68*-bull-sysv2* ) machine=sps7 opsys=usg5-2 ;; *************** *** 911,915 **** ! trap 'rm -f conftest* core; exit 1' 1 3 15 # NLS nuisances. --- 916,920 ---- ! trap 'rm -fr conftest* core; exit 1' 1 3 15 # NLS nuisances. *************** *** 1715,1718 **** --- 1720,1746 ---- 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 + + # 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 + 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 .. + rm -fr conftestdir + fi + + + fi + case "${window_system}" in "none" | "x11" | "x10" ) ;; *************** *** 2141,2145 **** done ! trap 'rm -f Makefile src/config.h conftest*; exit 1' 1 3 15 CC='$CC' LN_S='$LN_S' --- 2169,2173 ---- done ! trap 'rm -fr Makefile src/config.h conftest*; exit 1' 1 3 15 CC='$CC' LN_S='$LN_S' diff -rc2P --exclude-from=exceptions emacs-19.16/configure.in emacs-19.17/configure.in *** emacs-19.16/configure.in Tue Jul 6 02:53:27 1993 --- emacs-19.17/configure.in Sun Jul 18 02:03:00 1993 *************** *** 450,455 **** ;; ## Bull sps7 ! m68*-bull-sysv* ) machine=sps7 opsys=usg5-2 ;; --- 450,460 ---- ;; + ## Bull dpx2 + m68*-bull-sysv3* ) + machine=dpx2 opsys=usg5-3 + ;; + ## Bull sps7 ! m68*-bull-sysv2* ) machine=sps7 opsys=usg5-2 ;; *************** *** 993,996 **** --- 998,1009 ---- ;; 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 diff -rc2P --exclude-from=exceptions emacs-19.16/etc/ChangeLog emacs-19.17/etc/ChangeLog *** emacs-19.16/etc/ChangeLog Tue Jul 6 11:07:49 1993 --- emacs-19.17/etc/ChangeLog Mon Jul 19 02:02:59 1993 *************** *** 1,2 **** --- 1,6 ---- + 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) diff -rc2P --exclude-from=exceptions emacs-19.16/etc/MACHINES emacs-19.17/etc/MACHINES *** emacs-19.16/etc/MACHINES Sun Jul 4 16:03:12 1993 --- emacs-19.17/etc/MACHINES Sun Jul 18 02:05:05 1993 *************** *** 137,142 **** version. ! Bull sps7 (m68k-bull-sysv) Changes partially merged in version 19, but some fixes are probably required. --- 137,153 ---- version. ! Bull DPX/2 models 2nn or 3nn (m68k-bull-sysv3) + 19.12 works fine either with cc or gcc. + + You should compile with all the POSIX stuff: undef _SYSV and define + _POSIX_SOURCE, _XOPEN_SOURCE and _BULL_SOURCE. + + On bos2.00.45 there is a bug that makes the F_SETOWN fcntl() + call enters in an infinite loop. F_SETOWN_BUG has been defined to avoid + calling it. + + Bull sps7 (m68k-bull-sysv2) + Changes partially merged in version 19, but some fixes are probably required. *************** *** 271,282 **** Version 19 works under BSD. ! These machines are 68000-series CPUs running HP-UX (a derivative of sysV with some BSD features) or BSD 4.3 ported by Utah. The operating system suffix determines which system Emacs is built for. ! Series 200 HPUX runs Emacs only if it has the "HP-UX upgrade". ! 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 do not require any special software). If the file "/etc/filesets/C" exists on your machine, you have this software, otherwise you do not. --- 282,293 ---- Version 19 works under BSD. ! These machines are 68000-series CPUs running HP/UX (a derivative of sysV with some BSD features) or BSD 4.3 ported by Utah. The operating system suffix determines which system Emacs is built for. ! Series 200 HPUX runs Emacs only if it has the "HP/UX upgrade". ! 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 do not require any special software). If the file "/etc/filesets/C" exists on your machine, you have this software, otherwise you do not. *************** *** 293,297 **** Define C_SWITCH_MACHINE to be +X to make a version of Emacs that ! runs on both 68010 and 68020 based hp-ux's. Define HPUX_68010 if you are using the new assembler, for --- 304,308 ---- Define C_SWITCH_MACHINE to be +X to make a version of Emacs that ! runs on both 68010 and 68020 based HP/UX's. Define HPUX_68010 if you are using the new assembler, for *************** *** 312,324 **** These files support HP's Precision Architecture machines ! running HP-UX. It has been moderately tested on the Series 840. Use hppa1.1 for the 700 series and hppa1.0 for the 800 series machines. (Emacs may not actually care which one you use.) ! As of version 19.13, Emacs is reported to build (using GCC) and run on HP 9000/700 series machines running HP/UX versions 8.07 and 9.01. ! 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 do not require any special software). If the file "/etc/filesets/C" exists on your machine, you have this software, otherwise you do not. --- 323,346 ---- These files support HP's Precision Architecture machines ! running HP/UX. It has been moderately tested on the Series 840. Use hppa1.1 for the 700 series and hppa1.0 for the 800 series machines. (Emacs may not actually care which one you use.) ! As of version 19.16, Emacs is reported to build (using GCC) and run on HP 9000/700 series machines running HP/UX versions 8.07 and 9.01. ! Some people report trouble using the GNU memory allocator under ! HP/UX version 9. We are told that these problems go away if you ! obtain the latest patches for the HP/UX C compiler. James J Dempsey ! says that this set of versions works for him: ! /bin/cc: ! HP92453-01 A.09.28 HP C Compiler ! /lib/ccom: ! HP92453-01 A.09.28 HP C Compiler ! HP-UX SLLIC/OPTIMIZER HP-UX.09.00.23 02/18/93 ! Ucode Code Generator - HP-UX.09.00.23.5 (patch) 2/18/93 ! ! 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 do not require any special software). If the file "/etc/filesets/C" exists on your machine, you have this software, otherwise you do not. *************** *** 570,580 **** Emacs 19 has not been tested extensively yet, but it seems to work ! in a NeXTStep 3.0 terminal window. You may need to specify -traditional ! when src/Makefile builds xmakefile. ! ! Multiple frames (new with Emacs 19) might work with X, but this has ! not not been tested yet. NeXT users might want to implement direct ! operation with NeXTStep, but from the point of view of the GNU project, ! that is a distraction. Thanks to Thorsten Ohl for working on the NeXT port of Emacs 19. --- 592,602 ---- Emacs 19 has not been tested extensively yet, but it seems to work ! in a NeXTStep 3.0 terminal window, and under the X server called ! co-Xist. You may need to specify -traditional when src/Makefile ! builds xmakefile. ! ! NeXT users might want to implement direct operation with NeXTStep, ! but from the point of view of the GNU project, that is a ! distraction. Thanks to Thorsten Ohl for working on the NeXT port of Emacs 19. *************** *** 855,859 **** find where function init_sys_modes in sysdep.c sets sg.c_cc[VQUIT] and make it store 7 there. I have as yet no evidence of whether ! this problem, known in HP-UX, exists in other system V versions. System V rel 2.2 (usg5.2.2) --- 877,881 ---- find where function init_sys_modes in sysdep.c sets sg.c_cc[VQUIT] and make it store 7 there. I have as yet no evidence of whether ! this problem, known in HP/UX, exists in other system V versions. System V rel 2.2 (usg5.2.2) diff -rc2P --exclude-from=exceptions emacs-19.16/etc/NEWS emacs-19.17/etc/NEWS *** emacs-19.16/etc/NEWS Tue Jul 6 05:22:11 1993 --- emacs-19.17/etc/NEWS Sun Jul 18 02:31:21 1993 *************** *** 1,3 **** ! GNU Emacs NEWS -- history of user-visible changes. 18 Jun 1993 Copyright (C) 1993 Free Software Foundation, Inc. See the end for copying conditions. --- 1,3 ---- ! GNU Emacs NEWS -- history of user-visible changes. 7 Jul 1993 Copyright (C) 1993 Free Software Foundation, Inc. See the end for copying conditions. *************** *** 7,16 **** see the file LNEWS. Changes in version 19.16. * When dragging the mouse to select a region, Emacs now highlights the ! region as you drag. If you continue the drag beyond the boundaries of ! the window, Emacs scrolls its text until you return the mouse to the ! window, or release the button. * RET now exits `query-replace' and `query-replace-regexp'; this makes it --- 7,205 ---- see the file LNEWS. + Changes in version 19.17. + + * When Emacs displays a list of completions in a buffer, + you can select a completion by clicking mouse button 2 + on that completion. + + * Use the command `list-faces-display' to display a list of + all the currently defined faces, showing what they look like. + + * Menu bar items from local maps now come after the usual items. + + * The Help menu bar item always comes last in the menu bar. + + * If you enable Font-Lock mode on a buffer containing a program + (certain languages such as C and Lisp are supported), everything you + type is automatically given a face property appropriate to its + syntactic role. For example, there are faces for comments, string + constants, names of functions being defined, and so on. + + * Dunnet, an adventure game, is now available. + + * Several major modes now have their own menu bar items, + including Dired, Rmail, and Sendmail. We would like to add + suitable menu bar items to other major modes. + + * The key binding C-x a C-h has been eliminated. + This is because it got in the way of the general feature of typing + C-h after a prefix character. If you want to run + inverse-add-global-abbrev, you can use C-x a - or C-x a i g instead. + + * If you set the variable `rmail-mail-new-frame' to a non-nil value, + all the Rmail commands to send mail make a new frame to do it in. + When you send the message, or use the menu bar command not to send it, + that frame is deleted. + + * In Rmail, the o and C-o commands are now almost interchangeable. + Both commands check the format of the file you specify, and append + the message to it in Rmail format if it is an Rmail file, and in + inbox file format otherwise. C-o and o are different only when you + specify a new file. + + * The function `copy-face' now takes an optional fourth argument + NEW-FRAME. If you specify this, it copies the definition of face + OLD-FACE on frame FRAME to face NEW-NAME on frame NEW-FRAME. + + * A local map can now cancel out one of the global map's menu items. + Just define that subcommand of the menu item with `undefined' + as the definition. For example, this cancels out the `Buffers' item + for the current major mode: + + (local-set-key [menu-bar buffer] 'undefined) + + * To put global items at the end of the menu bar, use the new variable + `menu-bar-final-items'. It should be a list of symbols--event types + bound in the menu bar. The menu bar items for these symbols are + moved to the end. + + * The list returned by `buffer-local-variables' now contains cons-cell + elements of the form (SYMBOL . VALUE) only for buffer-local variables + that have values. For unbound buffer-local variables, the variable + name (symbol) appears directly as an element of the list. + + * The `modification-hooks' property of a character no longer affects + insertion; it runs only for deletion and modification of the character. + + To detect insertion, use `insert-in-front-hooks' and + `insert-behind-hooks' properties. The former runs when text is + inserted immediately preceding the character that has the property; + the latter runs when text is inserted immediately following the + character. + + * Buffer modification now runs hooks belonging to overlays as well as + hooks belonging to characters. If an overlay has a + `modification-hooks' property, it applies to any change to text in the + overlay, and any insertion within the overlay. If the overlay has a + `insert-in-front-hooks' property, it runs for insertion at the + beginning boundary of the overlay. If the overlay has an + `insert-behind-hooks' property, it runs for insertion at the end + boundary of the overlay. + + The values of these properties should be lists of functions. Each + function is called, receiving as arguments the overlay in question, + followed by the bounds of the range being modified. + + * The new `-name NAME' option directs Emacs to search for its X + resources using the name `NAME', and sets the title of the initial + frame. This argument was added for consistency with other X clients. + + * The new `-xrm DATABASE' option tells Emacs to treat the string + DATABASE as the text of an X resource database. Emacs searches + DATABASE for resource values, in addition to the usual places. This + argument was added for consistency with other X clients. + + * Emacs now searches for X resources in the files specified by the + XFILESEARCHPATH, XUSERFILESEARCHPATH, and XAPPLRESDIR environment + variables, emulating the functionality provided by programs written + using Xt. Because of this change, Emacs will now notice system-wide + application defaults files, as other X clients do. + + XFILESEARCHPATH and XUSERFILESEARCHPATH should be a list of file names + separated by colons; XAPPLRESDIR should be a list of directory names + separated by colons. + + Emacs searches for X resources + + specified on the command line, with the `-xrm RESOURCESTRING' + option, + + then in the value of the XENVIRONMENT environment variable, + - or if that is unset, in the file named ~/.Xdefaults-HOSTNAME if it exists + (where HOSTNAME is the hostname of the machine Emacs is running on), + + then in the screen-specific and server-wide resource properties + provided by the server, + - or if those properties are unset, in the file named ~/.Xdefaults + if it exists, + + then in the files listed in XUSERFILESEARCHPATH, + - or in files named LANG/Emacs in directories listed in XAPPLRESDIR + (where LANG is the value of the LANG environment variable), if + the LANG environment variable is set, + - or in files named Emacs in the directories listed in XAPPLRESDIR + - or in ~/LANG/Emacs (if the LANG environment variable is set), + - or in ~/Emacs, + + then in the files listed in XFILESEARCHPATH. + + The paths in the variables XFILESEARCHPATH, XUSERFILESEARCHPATH, and + XAPPLRESDIR may contain %-escapes (like the control strings passed to + the the Emacs lisp `format' function or C printf function), which + Emacs expands. + + %N is replaced by the string "Emacs" wherever it occurs. + %T is replaced by "app-defaults" wherever it occurs. + %S is replaced by the empty string wherever it occurs. + %L and %l are replaced by the value of the LANG environment variable; if LANG + is not set, Emacs does not use that directory or file name at all. + %C is replaced by the value of the resource named "customization" + (class "Customization"), as retrieved from the server's resource + properties or the user's ~/.Xdefaults file, or the empty string if + that resource doesn't exist. + + So, for example, + if XFILESEARCHPATH is set to the value + "/usr/lib/X11/%L/%T/%N%C:/usr/lib/X11/%T/%N%C:/usr/lib/X11/%T/%N", + and the LANG environment variable is set to + "english", + and the customization resource is the string + "-color", + then, in the last step of the process described above, Emacs checks + for resources in the first of the following files that is present and + readable: + /usr/lib/X11/english/app-defaults/Emacs-color + /usr/lib/X11/app-defaults/Emacs-color + /usr/lib/X11/app-defaults/Emacs + If the LANG environment variable is not set, then Emacs never uses the + first element of the path, "/usr/lib/X11/%L/%T/%N%C", because it + contains the %L escape. + + If XFILESEARCHPATH is unset, Emacs uses the default value + "/usr/lib/X11/%L/app-defaults/Emacs%C:\ + /usr/lib/X11/app-defaults/Emacs%C:\ + /usr/lib/X11/%L/app-defaults/Emacs:\ + /usr/lib/X11/app-defaults/Emacs" + + This feature was added for consistency with other X applications. + + * The new function `text-property-any' scans the region of text from + START to END to see if any character's property PROP is `eq' to + VALUE. If so, it returns the position of the first such character. + Otherwise, it returns nil. + + The optional fifth argument, OBJECT, specifies the string or buffer to + be examined. + + * The new function `text-property-not-all' scans the region of text from + START to END to see if any character's property PROP is not `eq' to + VALUE. If so, it returns the position of the first such character. + Otherwise, it returns nil. + + The optional fifth argument, OBJECT, specifies the string or buffer to + be examined. + + * The function `delete-windows-on' now takes an optional second + argument FRAME, which specifies which frames it should affect. + + If FRAME is nil or omitted, then `delete-windows-on' deletes windows + showing BUFFER (its first argument) on all frames. + + If FRAME is t, then `delete-windows-on' only deletes windows on the + selected frame; other frames are unaffected. + + If FRAME is a frame, then `delete-windows-on' only deletes windows on + the given frame; other frames are unaffected. + + Changes in version 19.16. * When dragging the mouse to select a region, Emacs now highlights the ! region as you drag (if Transient Mark mode is enabled). If you ! continue the drag beyond the boundaries of the window, Emacs scrolls ! the window at a steady rate until you either move the mouse back into ! the window or release the button. * RET now exits `query-replace' and `query-replace-regexp'; this makes it *************** *** 28,32 **** to be yanked ("pasted") the next time you yank. ! * If you enable Transient Mark mode and set mark-even-if-inactive to non-nil, then the region is highlighted in a transient fashion just as normally in Transient Mark mode, but the mark really remains active --- 217,221 ---- to be yanked ("pasted") the next time you yank. ! * If you enable Transient Mark mode and set `mark-even-if-inactive' to non-nil, then the region is highlighted in a transient fashion just as normally in Transient Mark mode, but the mark really remains active *************** *** 41,50 **** list of strings. ! * VC now displays in the mode line the head version number of the file ! you are visiting. This follows the string `RCS' or `SCCS'. ! If that version is locked, the name of the person who has locked it ! appears before the version number, with a colon between them. ! If other versions are locked, name/version pairs for those versions ! follow the head version number. * When using X, if you load the `paren' library, Emacs automatically --- 230,237 ---- list of strings. ! * If you are visiting a file that has locks registered under RCS, ! VC now displays each lock's owner and version number in the mode line ! after the string `RCS'. If there are no locks, VC displays the head ! version number. * When using X, if you load the `paren' library, Emacs automatically diff -rc2P --exclude-from=exceptions emacs-19.16/info/dir emacs-19.17/info/dir *** emacs-19.16/info/dir Sat May 15 00:10:58 1993 --- emacs-19.17/info/dir Sat Jul 17 14:49:40 1993 *************** *** 19,21 **** --- 19,22 ---- 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. diff -rc2P --exclude-from=exceptions emacs-19.16/lib-src/ChangeLog emacs-19.17/lib-src/ChangeLog *** emacs-19.16/lib-src/ChangeLog Tue Jul 6 12:07:21 1993 --- emacs-19.17/lib-src/ChangeLog Mon Jul 19 02:01:37 1993 *************** *** 1,2 **** --- 1,31 ---- + 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 + the help message into shorter strings, to placate chintzy C + compilers which can't handle strings that long. + + * wakeup.c: Use CPP tangle from autoconf manual to #include the + correct combination of and . + + Thu Jul 8 18:10:44 1993 Francesco Potorti` (pot@cnuce.cnr.it) + + * etags.c (alloca): removed all references to it. + (main): now calls xnew instead of alloca for portability. + (../src/config.h): included only if HAVE_CONFIG_H. + (const): void definition removed--config.h takes care of it. + + Thu Jul 8 18:35:28 1993 Francesco Potorti` (pot@cnuce.cnr.it) + + * etags.c (consider_token): was `==', now is `='. + (consider_token): DEFUNs now treated like funcs in ctags mode. + + * etags.c (LEVEL_OK_FOR_FUNCDEF): removed. + (C_entries): optimized the test that used LEVEL_OK_FOR_FUNCDEF. + (C_entries): removed a piece of useless code. + (C_entries): making typedef tags is delayed until a semicolon + is met. This handles "typedef int X, Y, Z;" correctly. + Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) diff -rc2P --exclude-from=exceptions emacs-19.16/lib-src/alloca.c emacs-19.17/lib-src/alloca.c *** emacs-19.16/lib-src/alloca.c Mon May 24 20:43:37 1993 --- emacs-19.17/lib-src/alloca.c Tue Jul 13 12:37:01 1993 *************** *** 46,50 **** provide an "address metric" ADDRESS_FUNCTION macro. */ ! #ifdef CRAY long i00afunc (); #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) --- 46,50 ---- provide an "address metric" ADDRESS_FUNCTION macro. */ ! #if defined (CRAY) && defined (CRAY_STACKSEG_END) long i00afunc (); #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) *************** *** 205,209 **** } ! #ifdef CRAY #ifdef DEBUG_I00AFUNC --- 205,209 ---- } ! #if defined (CRAY) && defined (CRAY_STACKSEG_END) #ifdef DEBUG_I00AFUNC diff -rc2P --exclude-from=exceptions emacs-19.16/lib-src/etags.c emacs-19.17/lib-src/etags.c *** emacs-19.16/lib-src/etags.c Tue Jun 29 18:48:52 1993 --- emacs-19.17/lib-src/etags.c Sun Jul 18 02:06:26 1993 *************** *** 27,49 **** */ #include "../src/config.h" - #undef static - - /* AIX requires this to be the first thing in the file. */ - #ifdef __GNUC__ - #ifndef alloca - #define alloca __builtin_alloca #endif - #else /* not __GNUC__ */ - #if HAVE_ALLOCA_H - #include - #else /* not HAVE_ALLOCA_H */ - #ifdef _AIX - #pragma alloca - #else /* not _AIX */ - char *alloca (); - #endif /* not _AIX */ - #endif /* not HAVE_ALLOCA_H */ - #endif /* not __GNUC__ */ #include --- 27,33 ---- */ + #ifdef HAVE_CONFIG_H #include "../src/config.h" #endif #include *************** *** 458,469 **** abbreviations for the long option names.\n\n", progname); ! fputs ("\ ! -a, --append\n\ ! Append tag entries to existing tags file.\n\ ! -C, --c++\n\ Treat files with `.c' and `.h' extensions as C++ code, not C\n\ code. Files with `.C', `.H', `.cxx', `.hxx', or `.cc'\n\ ! extensions are always assumed to be C++ code.\n\ ! -d, --defines\n\ Create tag entries for #defines, too.", stdout); --- 442,452 ---- abbreviations for the long option names.\n\n", progname); ! puts ("-a, --append\n\ ! Append tag entries to existing tags file."); ! puts ("-C, --c++\n\ Treat files with `.c' and `.h' extensions as C++ code, not C\n\ code. Files with `.C', `.H', `.cxx', `.hxx', or `.cc'\n\ ! extensions are always assumed to be C++ code."); ! fputs ("-d, --defines\n\ Create tag entries for #defines, too.", stdout); *************** *** 489,497 **** this means not to assume that a closing brace in the first\n\ column is the final brace of a function or structure\n\ ! definition.\n\ ! -t, --typedefs\n\ Generate tag entries for typedefs. This is the default\n\ ! behavior.\n\ ! -T, --typedefs-and-c++\n\ Generate tag entries for typedefs, struct/enum/union tags, and\n\ C++ member functions."); --- 472,480 ---- this means not to assume that a closing brace in the first\n\ column is the final brace of a function or structure\n\ ! definition."); ! puts ("-t, --typedefs\n\ Generate tag entries for typedefs. This is the default\n\ ! behavior."); ! puts ("-T, --typedefs-and-c++\n\ Generate tag entries for typedefs, struct/enum/union tags, and\n\ C++ member functions."); *************** *** 507,515 **** puts ("-B, --backward-search\n\ Write the search commands for the tag entries using '?', the\n\ ! backward-search command.\n\ ! -F, --forward-search\n\ Write the search commands for the tag entries using '/', the\n\ ! forward-search command.\n\ ! -u, --update\n\ Update the tag entries for the given files, leaving tag\n\ entries for other files in place. Currently, this is\n\ --- 490,498 ---- puts ("-B, --backward-search\n\ Write the search commands for the tag entries using '?', the\n\ ! backward-search command."); ! puts ("-F, --forward-search\n\ Write the search commands for the tag entries using '/', the\n\ ! forward-search command."); ! puts ("-u, --update\n\ Update the tag entries for the given files, leaving tag\n\ entries for other files in place. Currently, this is\n\ *************** *** 517,531 **** files and then rewriting the new entries at the end of the\n\ tags file. It is often faster to simply rebuild the entire\n\ ! tag file than to use this.\n\ ! -v, --vgrind\n\ Generates an index of items intended for human consumption,\n\ similar to the output of vgrind. The index is sorted, and\n\ ! gives the page number of each item.\n\ ! -x, --cxref\n\ Like --vgrind, but in the style of cxref, rather than vgrind.\n\ The output uses line numbers instead of page numbers, but\n\ beyond that the differences are cosmetic; try both to see\n\ ! which you like.\n\ ! -w, --no-warn\n\ Suppress warning messages about entries defined in multiple\n\ files."); --- 500,514 ---- files and then rewriting the new entries at the end of the\n\ tags file. It is often faster to simply rebuild the entire\n\ ! tag file than to use this."); ! puts ("-v, --vgrind\n\ Generates an index of items intended for human consumption,\n\ similar to the output of vgrind. The index is sorted, and\n\ ! gives the page number of each item."); ! puts ("-x, --cxref\n\ Like --vgrind, but in the style of cxref, rather than vgrind.\n\ The output uses line numbers instead of page numbers, but\n\ beyond that the differences are cosmetic; try both to see\n\ ! which you like."); ! puts ("-w, --no-warn\n\ Suppress warning messages about entries defined in multiple\n\ files."); *************** *** 549,553 **** int i; unsigned int nincluded_files = 0; ! char **included_files = (char **) alloca (argc * sizeof (char *)); char *this_file; #ifdef VMS --- 532,536 ---- int i; unsigned int nincluded_files = 0; ! char **included_files = xnew (argc, char *); char *this_file; #ifdef VMS *************** *** 1381,1385 **** stagseen, /* struct-like tag seen */ scolonseen, /* colon seen after struct-like tag */ ! sinbody /* in class body: recognize member func defs */ } STRUCTST; STRUCTST structdef; --- 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; *************** *** 1421,1432 **** */ - /* - * LEVEL_OK_FOR_FUNCDEF allows C++ function definition within class body. - * Currently typdef and structdef stuff (typedefs and struct - * definitions) are only noticed when level==0, but that may change. - */ - #define LEVEL_OK_FOR_FUNCDEF() \ - (level==0 || (cplpl && level==1 && structdef==sinbody)) - #define curlb (lbs[curndx].lb) #define othlb (lbs[1-curndx].lb) --- 1404,1407 ---- *************** *** 1468,1472 **** register int tokoff; /* offset in line of start of latest token */ register int toklen; /* length of latest token */ ! int level; /* current curly brace level */ logical incomm, inquote, inchar, quotednl, midtoken; logical cplpl; --- 1443,1447 ---- register int tokoff; /* offset in line of start of latest token */ register int toklen; /* length of latest token */ ! int cblev; /* current curly brace level */ logical incomm, inquote, inchar, quotednl, midtoken; logical cplpl; *************** *** 1481,1485 **** next_token_is_func = yacc_rules = FALSE; midtoken = inquote = inchar = incomm = quotednl = FALSE; ! level = 0; cplpl = c_ext & C_PLPL; --- 1456,1460 ---- next_token_is_func = yacc_rules = FALSE; midtoken = inquote = inchar = incomm = quotednl = FALSE; ! cblev = 0; cplpl = c_ext & C_PLPL; *************** *** 1574,1581 **** next_token_is_func = FALSE; midtoken = inquote = inchar = incomm = quotednl = FALSE; ! level = 0; yacc_rules = !yacc_rules; continue; ! } case '#': if (lp == newlb.buffer + 1 && definedef == dnone) --- 1549,1556 ---- next_token_is_func = FALSE; midtoken = inquote = inchar = incomm = quotednl = FALSE; ! cblev = 0; yacc_rules = !yacc_rules; continue; ! } case '#': if (lp == newlb.buffer + 1 && definedef == dnone) *************** *** 1585,1591 **** ! if (LEVEL_OK_FOR_FUNCDEF () && definedef != dignorerest - && structdef != scolonseen && funcdef != finlist) { --- 1560,1567 ---- ! /* Consider token only if some complicated conditions are satisfied. */ ! if (((cblev == 0 && structdef != scolonseen) ! || (cblev == 1 && cplpl && structdef == sinbody)) && definedef != dignorerest && funcdef != finlist) { *************** *** 1613,1617 **** if (yacc_rules || consider_token (c, lp, &tok, ! c_ext, level, &is_func)) { if (structdef == sinbody --- 1589,1593 ---- if (yacc_rules || consider_token (c, lp, &tok, ! c_ext, cblev, &is_func)) { if (structdef == sinbody *************** *** 1629,1633 **** } ! if (funcdef == ftagseen || structdef == stagseen) { if (newndx == curndx) --- 1605,1611 ---- } ! if (funcdef == ftagseen ! || structdef == stagseen ! || typdef == tend) { if (newndx == curndx) *************** *** 1684,1694 **** break; case ';': funcdef = fnone; /* FALLTHRU */ case ',': - if (funcdef != finlist) - funcdef = fnone; - if (level == 0 && typdef == tend) - typdef = tnone; /* FALLTHRU */ case '[': --- 1662,1673 ---- break; case ';': + if (cblev == 0 && typdef == tend) + { + typdef = tnone; + MAKE_TAG_FROM_OTH_LB (FALSE); + } funcdef = fnone; /* FALLTHRU */ case ',': /* FALLTHRU */ case '[': *************** *** 1729,1733 **** break; } ! level++; /* FALLTHRU */ case '*': --- 1708,1712 ---- break; } ! cblev++; /* FALLTHRU */ case '*': *************** *** 1740,1747 **** case '}': if (!noindentypedefs && lp == newlb.buffer + 1) ! level = 0; /* reset level if first column */ ! else if (level > 0) ! level--; ! if (level == 0) { if (typdef == tinbody) --- 1719,1726 ---- case '}': if (!noindentypedefs && lp == newlb.buffer + 1) ! cblev = 0; /* reset curly brace level if first column */ ! else if (cblev > 0) ! cblev--; ! if (cblev == 0) { if (typdef == tinbody) *************** *** 1786,1795 **** logical ! consider_token (c, lp, tokp, c_ext, level, is_func) register char c; /* IN: first char after the token */ register char *lp; /* IN: lp points to 2nd char after the token */ ! register TOKEN *tokp; /* IN */ ! int c_ext; /* IN */ ! int level; /* IN */ logical *is_func; /* OUT */ { --- 1765,1774 ---- logical ! consider_token (c, lp, tokp, c_ext, cblev, is_func) register char c; /* IN: first char after the token */ register char *lp; /* IN: lp points to 2nd char after the token */ ! register TOKEN *tokp; /* IN: token pointer */ ! int c_ext; /* IN: C extensions mask */ ! int cblev; /* IN: curly brace level */ logical *is_func; /* OUT */ { *************** *** 1872,1878 **** /* ! * This structdef business is currently only invoked when level==0. ! * It should be recursively invoked whatever the level, and a stack of ! * states kept, to allow for definitions of structs within structs. * * This structdef business is NOT invoked when we are ctags and the --- 1851,1858 ---- /* ! * This structdef business is currently only invoked when cblev==0. ! * It should be recursively invoked whatever the curly brace level, ! * and a stack of states kept, to allow for definitions of structs ! * within structs. * * This structdef business is NOT invoked when we are ctags and the *************** *** 1890,1894 **** case st_C_enum: if (typdef == ttypedseen ! || (typedefs_and_cplusplus && level == 0 && structdef == snone)) { structdef = skeyseen; --- 1870,1874 ---- case st_C_enum: if (typdef == ttypedseen ! || (typedefs_and_cplusplus && cblev == 0 && structdef == snone)) { structdef = skeyseen; *************** *** 1939,1942 **** --- 1919,1923 ---- { next_token_is_func = FALSE; + *is_func = TRUE; return (TRUE); } *************** *** 1946,1950 **** { case st_C_typespec: ! funcdef == fnone; /* should be useless */ return (FALSE); default: --- 1927,1931 ---- { case st_C_typespec: ! funcdef = fnone; /* should be useless */ return (FALSE); default: *************** *** 2407,2411 **** (void) strcpy (nambuf, dbp); cp[0] = c; ! pfnote (nambuf, TRUE, FALSE, lb.buffer, cp - lb.buffer + 1, lineno, linecharno); pfcnt++; } --- 2388,2393 ---- (void) strcpy (nambuf, dbp); cp[0] = c; ! pfnote (nambuf, TRUE, FALSE, lb.buffer, ! cp - lb.buffer + 1, lineno, linecharno); pfcnt++; } diff -rc2P --exclude-from=exceptions emacs-19.16/lib-src/getopt.c emacs-19.17/lib-src/getopt.c *** emacs-19.16/lib-src/getopt.c Sat Jun 26 15:30:01 1993 --- emacs-19.17/lib-src/getopt.c Thu Jul 8 13:20:26 1993 *************** *** 25,31 **** #endif ! #if !__STDC__ && !defined(const) && IN_GCC #define const #endif /* This tells Alpha OSF/1 not to define a getopt prototype in . */ --- 25,35 ---- #endif ! #ifndef __STDC__ ! /* This is a separate conditional since some stdc systems ! reject `defined (const)'. */ ! #ifndef const #define const #endif + #endif /* This tells Alpha OSF/1 not to define a getopt prototype in . */ *************** *** 182,186 **** /* If using GCC, we can safely declare strlen this way. ! If not using GCC, it is ok not to declare it. */ #ifdef __GNUC__ #ifdef IN_GCC --- 186,192 ---- /* If using GCC, we can safely declare strlen this way. ! If not using GCC, it is ok not to declare it. ! (Supposedly there are some machines where it might get a warning, ! but changing this conditional to __STDC__ is too risky.) */ #ifdef __GNUC__ #ifdef IN_GCC diff -rc2P --exclude-from=exceptions emacs-19.16/lib-src/wakeup.c emacs-19.17/lib-src/wakeup.c *** emacs-19.16/lib-src/wakeup.c Tue Jun 8 03:14:56 1993 --- emacs-19.17/lib-src/wakeup.c Sun Jul 18 02:06:29 1993 *************** *** 1,8 **** /* Program to produce output at regular intervals. */ #include - #include #include #include struct tm *localtime (); --- 1,19 ---- /* Program to produce output at regular intervals. */ + #include "config.h" + #include #include + + #ifdef TIME_WITH_SYS_TIME + #include + #include + #else + #ifdef HAVE_SYS_TIME_H #include + #else + #include + #endif + #endif struct tm *localtime (); diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/ChangeLog emacs-19.17/lisp/ChangeLog *** emacs-19.16/lisp/ChangeLog Tue Jul 6 11:08:00 1993 --- emacs-19.17/lisp/ChangeLog Mon Jul 19 02:01:07 1993 *************** *** 1,2 **** --- 1,449 ---- + 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) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/advice.el emacs-19.17/lisp/advice.el *** emacs-19.16/lisp/advice.el Wed May 26 00:12:06 1993 --- emacs-19.17/lisp/advice.el Fri Jul 16 15:52:23 1993 *************** *** 2032,2036 **** ;;;###autoload ! (defvar ad-start-advice-on-load nil "*Non-NIL will start advice magic when this file gets loaded. Also see function `ad-start-advice'.") --- 2032,2036 ---- ;;;###autoload ! (defvar ad-start-advice-on-load t "*Non-NIL will start advice magic when this file gets loaded. Also see function `ad-start-advice'.") diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/ange-ftp.el emacs-19.17/lisp/ange-ftp.el *** emacs-19.16/lisp/ange-ftp.el Wed Jun 23 23:02:29 1993 --- emacs-19.17/lisp/ange-ftp.el Sun Jul 18 02:18:15 1993 *************** *** 857,861 **** ;;;; ------------------------------------------------------------ ! (defconst ange-ftp-version "$Revision: 1.29 $") (defvar ange-ftp-data-buffer-name " *ftp data*" --- 857,861 ---- ;;;; ------------------------------------------------------------ ! (defconst ange-ftp-version "$Revision: 1.30 $") (defvar ange-ftp-data-buffer-name " *ftp data*" *************** *** 3756,3760 **** (or (assoc "^/[^/:]*\\([^/:]:\\|\\'\\)" file-name-handler-alist) (setq file-name-handler-alist ! (cons '("^/[^/:]+:" . ange-ftp-hook-function) file-name-handler-alist))) --- 3756,3760 ---- (or (assoc "^/[^/:]*\\([^/:]:\\|\\'\\)" file-name-handler-alist) (setq file-name-handler-alist ! (cons '("^/[^/:]*\\([^/:]:\\|\\'\\)" . ange-ftp-hook-function) file-name-handler-alist))) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/assoc.el emacs-19.17/lisp/assoc.el *** emacs-19.16/lisp/assoc.el Wed Jun 16 17:39:03 1993 --- emacs-19.17/lisp/assoc.el Thu Jul 15 01:07:41 1993 *************** *** 24,28 **** ;;; Code: ! (defun asort (assoc-symbol key) "Move a specified key-value pair to the head of an alist. The alist is referenced by ALIST-SYMBOL. Key-value pair to move to --- 24,28 ---- ;;; Code: ! (defun asort (alist-symbol key) "Move a specified key-value pair to the head of an alist. The alist is referenced by ALIST-SYMBOL. Key-value pair to move to diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/autoload.el emacs-19.17/lisp/autoload.el *** emacs-19.16/lisp/autoload.el Sat Jul 3 03:21:40 1993 --- emacs-19.17/lisp/autoload.el Wed Jul 14 16:54:47 1993 *************** *** 123,131 **** ;; relative to the current buffer's directory. (setq file (expand-file-name file)) ! (if (and (< (length default-directory) (length file)) ! (string= default-directory ! (substring file 0 (length default-directory)))) ! (progn ! (setq file (substring file (length default-directory))))) (message "Generating autoloads for %s..." file) --- 123,133 ---- ;; relative to the current buffer's directory. (setq file (expand-file-name file)) ! (let* ((source-truename (file-truename file)) ! (dir-truename (file-name-as-directory ! (file-truename default-directory))) ! (len (length dir-truename))) ! (if (and (< len (length source-truename)) ! (string= dir-truename (substring source-truename 0 len))) ! (setq file (substring source-truename len)))) (message "Generating autoloads for %s..." file) *************** *** 236,240 **** (goto-char (point-min)) (while (search-forward generate-autoload-section-header nil t) - (or done (setq done 'seen)) (let ((form (condition-case () (read (current-buffer)) --- 238,241 ---- *************** *** 258,275 **** (setq done t)))))) (if done () ! ;; Have the user tell us where to put the section. ! (save-window-excursion ! (switch-to-buffer (current-buffer)) ! (with-output-to-temp-buffer "*Help*" ! (princ (substitute-command-keys ! (format "\ Move point to where the autoload section for %s should be inserted. Then do \\[exit-recursive-edit]." ! file)))) ! (recursive-edit) ! (beginning-of-line)) ! (generate-file-autoloads file))) (if (interactive-p) (save-buffer)) (if (and (null existing-buffer) --- 259,283 ---- (setq done t)))))) (if done + ;; There was an existing section and we have updated it. () ! (if (save-excursion ! (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. ! (progn ! (save-window-excursion ! (switch-to-buffer (current-buffer)) ! (with-output-to-temp-buffer "*Help*" ! (princ (substitute-command-keys ! (format "\ Move point to where the autoload section for %s should be inserted. Then do \\[exit-recursive-edit]." ! file)))) ! (recursive-edit) ! (beginning-of-line)) ! (generate-file-autoloads file))))) (if (interactive-p) (save-buffer)) (if (and (null existing-buffer) *************** *** 329,333 **** For example, invoke \"emacs -batch -f batch-update-autoloads *.el\"" (if (not noninteractive) ! (error "batch-update-file-autoloads is to be used only with -batch")) (let ((lost nil) (args command-line-args-left)) --- 337,341 ---- For example, invoke \"emacs -batch -f batch-update-autoloads *.el\"" (if (not noninteractive) ! (error "batch-update-autoloads is to be used only with -batch")) (let ((lost nil) (args command-line-args-left)) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/bytecomp.el emacs-19.17/lisp/bytecomp.el *** emacs-19.16/lisp/bytecomp.el Mon Jul 5 05:56:27 1993 --- emacs-19.17/lisp/bytecomp.el Sun Jul 18 02:02:01 1993 *************** *** 1245,1249 **** (let (outbuffer) (let (;; Prevent truncation of flonums and lists as we read and print them ! (float-output-format "%20e") (case-fold-search nil) (print-length nil) --- 1245,1249 ---- (let (outbuffer) (let (;; Prevent truncation of flonums and lists as we read and print them ! (float-output-format "%.20e") (case-fold-search nil) (print-length nil) *************** *** 2421,2427 **** (defun byte-compile-setq-default (form) ! (byte-compile-form ! (cons 'set-default (cons (list 'quote (nth 1 form)) ! (nthcdr 2 form))))) (defun byte-compile-quote (form) --- 2421,2432 ---- (defun byte-compile-setq-default (form) ! (let ((args (cdr form)) ! setters) ! (while args ! (setq setters ! (cons (list 'set-default (list 'quote (car args)) (car (cdr args))) ! setters)) ! (setq args (cdr (cdr args)))) ! (byte-compile-form (cons 'progn (nreverse setters))))) (defun byte-compile-quote (form) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/calendar.el emacs-19.17/lisp/calendar.el *** emacs-19.16/lisp/calendar.el Mon Jun 21 15:33:43 1993 --- emacs-19.17/lisp/calendar.el Sat Jul 10 23:28:39 1993 *************** *** 756,760 **** See the documentation for `calendar-holidays' for details.") - ;;;###autoload (defvar calendar-holidays (append general-holidays local-holidays other-holidays --- 756,759 ---- diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/comint.el emacs-19.17/lisp/comint.el *** emacs-19.16/lisp/comint.el Sun Jul 4 17:00:59 1993 --- emacs-19.17/lisp/comint.el Fri Jul 16 16:28:37 1993 *************** *** 280,283 **** --- 280,287 ---- ; (define-key comint-mode-map "\eN" 'comint-psearch-input) ; (define-key comint-mode-map "\C-cR" 'comint-msearch-input-matching) + (define-key comint-mode-map "\C-c\C-n" 'comint-next-prompt) + (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 ) *************** *** 900,905 **** --- 904,930 ---- (delete-char arg))) + (defun comint-send-eof () + "Send an EOF to the current buffer's process." + (interactive) + (process-send-eof)) + (defun comint-next-prompt (n) + "\ + Move to end of next prompt in the buffer (with prefix arg, Nth next). + See `comint-prompt-regexp'." + (interactive "p") + (re-search-forward comint-prompt-regexp nil nil n)) + (defun comint-prev-prompt (n) + "\ + Move to end of previous prompt in the buffer (with prefix arg, Nth previous). + See `comint-prompt-regexp'." + (interactive "p") + (if (= (save-excursion (re-search-backward comint-prompt-regexp nil t) + (match-end 0)) + (point)) + (setq n (1+ n))) + (re-search-backward comint-prompt-regexp nil nil n) + (goto-char (match-end 0))) ;;; Support for source-file processing commands. diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/compare-w.el emacs-19.17/lisp/compare-w.el *** emacs-19.16/lisp/compare-w.el Mon Mar 22 09:41:14 1993 --- emacs-19.17/lisp/compare-w.el Tue Jul 13 03:31:05 1993 *************** *** 1,5 **** ;;; compare-w.el --- compare text between windows for Emacs. ! ;; Copyright (C) 1986, 1989 Free Software Foundation, Inc. ;; Maintainer: FSF --- 1,5 ---- ;;; compare-w.el --- compare text between windows for Emacs. ! ;; Copyright (C) 1986, 1989, 1993 Free Software Foundation, Inc. ;; Maintainer: FSF *************** *** 30,35 **** ;;; Code: ! (defvar compare-windows-whitespace " \t\n" ! "*String of characters considered whitespace for \\[compare-windows]. Changes in whitespace are optionally ignored. --- 30,35 ---- ;;; Code: ! (defvar compare-windows-whitespace "[ \t\n]+" ! "*Regexp that defines whitespace sequences for \\[compare-windows]. Changes in whitespace are optionally ignored. *************** *** 62,67 **** opoint2 (skip-whitespace (if ignore-whitespace ! compare-windows-whitespace)) ! (skip-whitespace-regexp (concat "[" skip-whitespace "]+"))) (setq p1 (point) b1 (current-buffer)) (setq w2 (next-window (selected-window))) --- 62,66 ---- opoint2 (skip-whitespace (if ignore-whitespace ! compare-windows-whitespace))) (setq p1 (point) b1 (current-buffer)) (setq w2 (next-window (selected-window))) *************** *** 89,110 **** (save-excursion (let (p1a p2a w1 w2 result1 result2) ! (if (stringp skip-whitespace) ! (progn ! (if (not (eobp)) ! (skip-chars-backward skip-whitespace opoint1)) ! (and (looking-at skip-whitespace-regexp) ! (setq p1a (match-end 0) result1 t))) ! (setq result1 (funcall skip-whitespace opoint1)) ! (setq p1a (point))) (set-buffer b2) (goto-char p2) ! (if (stringp skip-whitespace) ! (progn ! (if (not (eobp)) ! (skip-chars-backward skip-whitespace opoint2)) ! (and (looking-at skip-whitespace-regexp) ! (setq p2a (match-end 0) result2 t))) ! (setq result2 (funcall skip-whitespace opoint2)) ! (setq p2a (point))) (and result1 result2 (eq result1 result2) (setq p1 p1a --- 88,103 ---- (save-excursion (let (p1a p2a w1 w2 result1 result2) ! (setq result1 ! (if (stringp skip-whitespace) ! (compare-windows-skip-whitespace opoint1) ! (funcall skip-whitespace opoint1))) ! (setq p1a (point)) (set-buffer b2) (goto-char p2) ! (setq result2 ! (if (stringp skip-whitespace) ! (compare-windows-skip-whitespace opoint2) ! (funcall skip-whitespace opoint2))) ! (setq p2a (point)) (and result1 result2 (eq result1 result2) (setq p1 p1a *************** *** 135,138 **** --- 128,151 ---- (if (= (point) opoint1) (ding)))) + + ;; Move forward over whatever might be called whitespace. + ;; compare-windows-whitespace is a regexp that matches whitespace. + ;; Match it at various starting points before the original point + ;; and find the latest point at which a match ends. + ;; Don't try starting points before START, though. + ;; Value is non-nil if whitespace is found. + (defun compare-windows-skip-whitespace (start) + (let ((end (point)) + (opoint (point))) + (while (and (looking-at compare-windows-whitespace) + (<= end (match-end 0)) + ;; This match goes past END, so advance END. + (progn (setq end (match-end 0)) + (> (point) start))) + ;; keep going back until whitespace + ;; doesn't extend to or past end + (forward-char -1)) + (goto-char end) + (/= end opoint))) (provide 'compare-w) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/compile.el emacs-19.17/lisp/compile.el *** emacs-19.16/lisp/compile.el Wed Jun 30 18:02:59 1993 --- emacs-19.17/lisp/compile.el Wed Jul 14 23:08:05 1993 *************** *** 127,132 **** ("([ \t]*\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2) ! ;; Line 45 of "foo.c": bloofel undefined (who does this?) ! ("\n[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+of[ \t]+\"\\([^\"\n]+\\)\":" 2 1) ;; Apollo cc, 4.3BSD fc: --- 127,136 ---- ("([ \t]*\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2) ! ;; Ultrix 3.0 f77: ! ;; Error on line 3 of t.f: Execution error unclassifiable statement ! ;; Unknown who does this: ! ;; Line 45 of "foo.c": bloofel undefined ! ("\n\\(Error on \\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ ! of[ \t]+\"?\\([^\"\n]+\\)\"?:" 3 2) ;; Apollo cc, 4.3BSD fc: *************** *** 914,918 **** ;; This matters for grep. (if (bobp) ! (forward-line 2)) ;; Compile all the regexps we want to search for into one. --- 918,927 ---- ;; This matters for grep. (if (bobp) ! (progn ! (forward-line 2) ! ;; Move back so point is before the newline. ! ;; This matters because some error regexps use \n instead of ^ ! ;; to be faster. ! (forward-char -1))) ;; Compile all the regexps we want to search for into one. diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/cookie1.el emacs-19.17/lisp/cookie1.el *** emacs-19.16/lisp/cookie1.el Wed Jun 2 14:40:29 1993 --- emacs-19.17/lisp/cookie1.el Wed Jul 14 19:34:31 1993 *************** *** 61,64 **** --- 61,67 ---- "Delimiter used to separate cookie file entries.") + (defvar cookie-cache (make-vector 511 0) + "Cache of cookie files that have already been snarfed.") + (defun cookie (phrase-file startmsg endmsg) "Return a random phrase from PHRASE-FILE. When the phrase file *************** *** 90,110 **** STARTMSG and ENDMSG before and after. Caches the result; second and subsequent calls on the same file won't go to disk." ! (if (boundp (intern phrase-file)) ! (eval (intern phrase-file)) ! (message startmsg) ! (save-excursion ! (let ((buf (generate-new-buffer "*cookie*")) ! (result nil)) ! (set-buffer buf) ! (insert-file-contents (expand-file-name phrase-file)) ! (re-search-forward cookie-delimiter) ! (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp))) ! (let ((beg (point))) ! (re-search-forward cookie-delimiter) ! (setq result (cons (buffer-substring beg (1- (point))) ! result)))) ! (kill-buffer buf) ! (message endmsg) ! (set (intern phrase-file) (apply 'vector result)))))) (defun pick-random (n) --- 93,121 ---- STARTMSG and ENDMSG before and after. Caches the result; second and subsequent calls on the same file won't go to disk." ! (let ((sym (intern-soft phrase-file cookie-cache))) ! (and sym (not (equal (symbol-function sym) ! (nth 5 (file-attributes phrase-file)))) ! (yes-or-no-p (concat phrase-file ! " has changed. Read new contents? ")) ! (setq sym nil)) ! (if sym ! (symbol-value sym) ! (setq sym (intern phrase-file cookie-cache)) ! (message startmsg) ! (save-excursion ! (let ((buf (generate-new-buffer "*cookie*")) ! (result nil)) ! (set-buffer buf) ! (fset sym (nth 5 (file-attributes phrase-file))) ! (insert-file-contents (expand-file-name phrase-file)) ! (re-search-forward cookie-delimiter) ! (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp))) ! (let ((beg (point))) ! (re-search-forward cookie-delimiter) ! (setq result (cons (buffer-substring beg (1- (point))) ! result)))) ! (kill-buffer buf) ! (message endmsg) ! (set sym (apply 'vector result))))))) (defun pick-random (n) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/dired.el emacs-19.17/lisp/dired.el *** emacs-19.16/lisp/dired.el Fri Jun 18 13:54:58 1993 --- emacs-19.17/lisp/dired.el Mon Jul 12 23:57:11 1993 *************** *** 732,735 **** --- 732,862 ---- minor-mode-alist))) + ;; Make menu bar items. + + ;; Get rid of the Edit menu bar item to save space. + (define-key dired-mode-map [menu-bar edit] 'undefined) + + (define-key dired-mode-map [menu-bar subdir] + (cons "Subdir" (make-sparse-keymap "Subdir"))) + + (define-key dired-mode-map [menu-bar subdir hide-all] + '("Hide All" . dired-hide-all)) + (define-key dired-mode-map [menu-bar subdir hide-subdir] + '("Hide Subdir" . dired-hide-subdir)) + (define-key dired-mode-map [menu-bar subdir tree-down] + '("Tree Down" . dired-tree-down)) + (define-key dired-mode-map [menu-bar subdir tree-up] + '("Tree Up" . dired-tree-up)) + (define-key dired-mode-map [menu-bar subdir up] + '("Up Directory" . dired-up-directory)) + (define-key dired-mode-map [menu-bar subdir prev-subdir] + '("Prev Subdir" . dired-prev-subdir)) + (define-key dired-mode-map [menu-bar subdir next-subdir] + '("Next Subdir" . dired-next-subdir)) + (define-key dired-mode-map [menu-bar subdir prev-dirline] + '("Prev Dirline" . dired-prev-dirline)) + (define-key dired-mode-map [menu-bar subdir next-dirline] + '("Next Dirline" . dired-next-dirline)) + (define-key dired-mode-map [menu-bar subdir insert] + '("Insert This Subdir" . dired-maybe-insert-subdir)) + + (define-key dired-mode-map [menu-bar immediate] + (cons "Immediate" (make-sparse-keymap "Immediate"))) + + (define-key dired-mode-map [menu-bar immediate backup-diff] + '("Compare with Backup" . dired-backup-diff)) + (define-key dired-mode-map [menu-bar immediate diff] + '("Diff" . dired-diff)) + (define-key dired-mode-map [menu-bar immediate view] + '("View This File" . dired-view-file)) + (define-key dired-mode-map [menu-bar immediate display] + '("Display in Other Window" . dired-display-file)) + (define-key dired-mode-map [menu-bar immediate find-file-other-window] + '("Find in Other Window" . dired-find-file-other-window)) + (define-key dired-mode-map [menu-bar immediate find-file] + '("Find This File" . dired-find-file)) + (define-key dired-mode-map [menu-bar immediate create-directory] + '("Create Directory..." . dired-create-directory)) + + (define-key dired-mode-map [menu-bar regexp] + (cons "Regexp" (make-sparse-keymap "Regexp"))) + + (define-key dired-mode-map [menu-bar regexp downcase] + '("Downcase" . dired-downcase)) + (define-key dired-mode-map [menu-bar regexp upcase] + '("Upcase" . dired-upcase)) + (define-key dired-mode-map [menu-bar regexp hardlink] + '("Hardlink..." . dired-do-hardlink-regexp)) + (define-key dired-mode-map [menu-bar regexp symlink] + '("Symlink..." . dired-do-symlink-regexp)) + (define-key dired-mode-map [menu-bar regexp rename] + '("Rename..." . dired-do-rename-regexp)) + (define-key dired-mode-map [menu-bar regexp copy] + '("Copy..." . dired-do-copy-regexp)) + (define-key dired-mode-map [menu-bar regexp flag] + '("Flag..." . dired-flag-files-regexp)) + (define-key dired-mode-map [menu-bar regexp mark] + '("Mark..." . dired-mark-files-regexp)) + + (define-key dired-mode-map [menu-bar mark] + (cons "Mark" (make-sparse-keymap "Mark"))) + + (define-key dired-mode-map [menu-bar mark prev] + '("Previous Marked" . dired-prev-marked-file)) + (define-key dired-mode-map [menu-bar mark next] + '("Next Marked" . dired-next-marked-file)) + (define-key dired-mode-map [menu-bar mark marks] + '("Change Marks..." . dired-change-marks)) + (define-key dired-mode-map [menu-bar mark symlinks] + '("Mark Symlinks" . dired-mark-symlinks)) + (define-key dired-mode-map [menu-bar mark directories] + '("Mark Directories" . dired-mark-directories)) + (define-key dired-mode-map [menu-bar mark directory] + '("Mark Old Backups" . dired-clean-directory)) + (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] + '("Flag" . dired-flag-file-deletion)) + (define-key dired-mode-map [menu-bar mark unmark] + '("Unmark" . dired-unmark)) + (define-key dired-mode-map [menu-bar mark mark] + '("Mark" . dired-mark)) + + (define-key dired-mode-map [menu-bar operate] + (cons "Operate" (make-sparse-keymap "Operate"))) + + (define-key dired-mode-map [menu-bar operate chown] + '("Change Owner..." . dired-do-chown)) + (define-key dired-mode-map [menu-bar operate chgrp] + '("Change Group..." . dired-do-chgrp)) + (define-key dired-mode-map [menu-bar operate chmod] + '("Change Mode..." . dired-do-chmod)) + (define-key dired-mode-map [menu-bar operate load] + '("Load" . dired-do-load)) + (define-key dired-mode-map [menu-bar operate compile] + '("Byte-compile" . dired-do-byte-compile)) + (define-key dired-mode-map [menu-bar operate compress] + '("Compress" . dired-do-compress)) + (define-key dired-mode-map [menu-bar operate print] + '("Print" . dired-do-print)) + (define-key dired-mode-map [menu-bar operate hardlink] + '("Hardlink to..." . dired-do-hardlink)) + (define-key dired-mode-map [menu-bar operate symlink] + '("Symlink to..." . dired-do-symlink)) + (define-key dired-mode-map [menu-bar operate command] + '("Shell Command..." . dired-do-shell-command)) + (define-key dired-mode-map [menu-bar operate delete] + '("Delete" . dired-do-delete)) + (define-key dired-mode-map [menu-bar operate rename] + '("Rename to..." . dired-do-rename)) + (define-key dired-mode-map [menu-bar operate copy] + '("Copy to..." . dired-do-copy)) + ;; Dired mode is suitable only for specially formatted data. (put 'dired-mode 'mode-class 'special) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/dunnet.el emacs-19.17/lisp/dunnet.el *** emacs-19.16/lisp/dunnet.el --- emacs-19.17/lisp/dunnet.el Tue Jul 13 16:44:02 1993 *************** *** 0 **** --- 1,3328 ---- + ;;; dunnet.el --- Text adventure for Emacs + + ;; Author: Ron Schnell + ;; Created: 25 Jul 1992 + ;; Version: 2.0 + ;; Keywords: games + ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to + ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;;; Commentary: + + ;; This game can be run in batch mode. To do this, use: + ;; emacs -batch -l dunnet + + ;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ;;; The log file should be set for your system, and it must + ;;; be writeable by all. + + + (defvar dun-log-file "/usr/local/dunnet.score" + "Name of file to store score information for dunnet.") + + (if nil + (eval-and-compile (setq byte-compile-warnings nil))) + + (require 'cl) + + ;;;; Mode definitions for interactive mode + + (defun dun-mode () + "Major mode for running dunnet." + (interactive) + (text-mode) + (use-local-map dungeon-mode-map) + (setq major-mode 'dungeon-mode) + (setq mode-name "Dungeon")) + + (defun dun-parse (arg) + "Function called when return is pressed in interactive mode to parse line." + (interactive "*p") + (beginning-of-line) + (setq beg (+ (point) 1)) + (end-of-line) + (if (and (not (= beg (point))) (not (< (point) beg)) + (string= ">" (buffer-substring (- beg 1) beg))) + (progn + (setq line (downcase (buffer-substring beg (point)))) + (princ line) + (if (eq (dun-vparse dun-ignore dun-verblist line) -1) + (dun-mprinc "I don't understand that.\n"))) + (goto-char (point-max)) + (dun-mprinc "\n")) + (dun-messages)) + + (defun dun-messages () + (if dun-dead + (text-mode) + (if (eq dungeon-mode 'dungeon) + (progn + (if (not (= room dun-current-room)) + (progn + (dun-describe-room dun-current-room) + (setq room dun-current-room))) + (dun-fix-screen) + (dun-mprinc ">"))))) + + + ;;;###autoload + (defun dunnet () + "Switch to *dungeon* buffer and start game." + (interactive) + (switch-to-buffer "*dungeon*") + (dun-mode) + (setq dun-dead nil) + (setq room 0) + (dun-messages)) + + ;;;; + ;;;; This section contains all of the verbs and commands. + ;;;; + + ;;; Give long description of room if haven't been there yet. Otherwise + ;;; short. Also give long if we were called with negative room number. + + (defun dun-describe-room (room) + (if (and (not (member (abs room) dun-light-rooms)) + (not (member obj-lamp dun-inventory))) + (dun-mprincl "It is pitch dark. You are likely to be eaten by a grue.") + (dun-mprincl (cadr (nth (abs room) dun-rooms))) + (if (and (and (or (member room dun-visited) + (string= dun-mode "dun-superb")) (> room 0)) + (not (string= dun-mode "long"))) + nil + (dun-mprinc (car (nth (abs room) dun-rooms))) + (dun-mprinc "\n")) + (if (not (string= dun-mode "long")) + (if (not (member (abs room) dun-visited)) + (setq dun-visited (append (list (abs room)) dun-visited)))) + (dolist (xobjs (nth dun-current-room dun-room-objects)) + (if (= xobjs obj-special) + (dun-special-object) + (if (>= xobjs 0) + (dun-mprincl (car (nth xobjs dun-objects))) + (if (not (and (= xobjs obj-bus) dun-inbus)) + (progn + (dun-mprincl (car (nth (abs xobjs) dun-perm-objects))))))) + (if (and (= xobjs obj-jar) dun-jar) + (progn + (dun-mprincl "The jar contains:") + (dolist (x dun-jar) + (dun-mprinc " ") + (dun-mprincl (car (nth x dun-objects))))))) + (if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus) + (dun-mprincl "You are on the bus.")))) + + ;;; There is a special object in the room. This object's description, + ;;; or lack thereof, depends on certain conditions. + + (defun dun-special-object () + + (if (= dun-current-room computer-room) + (if dun-computer + (dun-mprincl + "The panel lights are flashing in a seemingly organized pattern.") + (dun-mprincl "The panel lights are steady and motionless."))) + + (if (and (= dun-current-room red-room) + (not (member obj-towel (nth red-room dun-room-objects)))) + (dun-mprincl "There is a hole in the floor here.")) + + (if (and (= dun-current-room marine-life-area) dun-black) + (dun-mprincl + "The room is lit by a black light, causing the fish, and some of + your objects, to give off an eerie glow.")) + (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) + (progn + (if (not dun-correct-answer) + (dun-endgame-question) + (dun-mprincl "Your question is:") + (dun-mprincl dun-endgame-question)))) + + (if (= dun-current-room sauna) + (progn + (dun-mprincl (nth dun-sauna-level '( + "It is normal room temperature in here." + "It is luke warm in here." + "It is comfortably hot in here." + "It is refreshingly hot in here." + "You are dead now."))) + (if (and (= dun-sauna-level 3) + (or (member obj-rms dun-inventory) + (member obj-rms (nth dun-current-room dun-room-objects)))) + (progn + (dun-mprincl + "You notice the wax on your statuette beginning to melt, until it completely + melts off. You are left with a beautiful diamond!") + (if (member obj-rms dun-inventory) + (progn + (dun-remove-obj-from-inven obj-rms) + (setq dun-inventory (append dun-inventory + (list obj-diamond)))) + (dun-remove-obj-from-room dun-current-room obj-rms) + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (list obj-diamond)))) + (if (member obj-floppy dun-inventory) + (progn + (dun-mprincl + "You notice your floppy disk beginning to melt. As you grab for it, the + disk bursts into flames, and disintegrates.") + (dun-remove-obj-from-inven obj-floppy) + (dun-remove-obj-from-room dun-current-room obj-floppy))))) + ))) + + (defun dun-die (murderer) + (dun-mprinc "\n") + (if murderer + (dun-mprincl "You are dead.")) + (dun-do-logfile 'dun-die murderer) + (dun-score nil) + (setq dun-dead t)) + + (defun dun-quit (args) + (dun-die nil)) + + ;;; Print every object in player's inventory. Special case for the jar, + ;;; as we must also print what is in it. + + (defun dun-inven (args) + (dun-mprinc "You currently have:") + (dun-mprinc "\n") + (dolist (curobj dun-inventory) + (if curobj + (progn + (dun-mprincl (cadr (nth curobj dun-objects))) + (if (and (= curobj obj-jar) dun-jar) + (progn + (dun-mprincl "The jar contains:") + (dolist (x dun-jar) + (dun-mprinc " ") + (dun-mprincl (cadr (nth x dun-objects)))))))))) + + (defun dun-shake (obj) + (let (objnum) + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (member objnum dun-inventory) + (progn + ;;; If shaking anything will do anything, put here. + (dun-mprinc "Shaking ") + (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) + (dun-mprinc " seems to have no effect.") + (dun-mprinc "\n") + ) + (if (and (not (member objnum (nth dun-current-room dun-room-silents))) + (not (member objnum (nth dun-current-room dun-room-objects)))) + (dun-mprincl "I don't see that here.") + ;;; Shaking trees can be deadly + (if (= objnum obj-tree) + (progn + (dun-mprinc + "You begin to shake a tree, and notice a coconut begin to fall from the air. + As you try to get your hand up to block it, you feel the impact as it lands + on your head.") + (dun-die "a coconut")) + (if (= objnum obj-bear) + (progn + (dun-mprinc + "As you go up to the bear, it removes your head and places it on the ground.") + (dun-die "a bear")) + (if (< objnum 0) + (dun-mprincl "You cannot shake that.") + (dun-mprincl "You don't have that."))))))))) + + + (defun dun-drop (obj) + (if dun-inbus + (dun-mprincl "You can't drop anything while on the bus.") + (let (objnum ptr) + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (not (setq ptr (member objnum dun-inventory))) + (dun-mprincl "You don't have that.") + (progn + (dun-remove-obj-from-inven objnum) + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (list objnum))) + (dun-mprincl "Done.") + (if (member objnum (list obj-food obj-weight obj-jar)) + (dun-drop-check objnum)))))))) + + ;;; Dropping certain things causes things to happen. + + (defun dun-drop-check (objnum) + (if (and (= objnum obj-food) (= room bear-hangout) + (member obj-bear (nth bear-hangout dun-room-objects))) + (progn + (dun-mprincl + "The bear takes the food and runs away with it. He left something behind.") + (dun-remove-obj-from-room dun-current-room obj-bear) + (dun-remove-obj-from-room dun-current-room obj-food) + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (list obj-key))))) + + (if (and (= objnum obj-jar) (member obj-nitric dun-jar) + (member obj-glycerine dun-jar)) + (progn + (dun-mprincl + "As the jar impacts the ground it explodes into many pieces.") + (setq dun-jar nil) + (dun-remove-obj-from-room dun-current-room obj-jar) + (if (= dun-current-room fourth-vermont-intersection) + (progn + (setq dun-hole t) + (setq dun-current-room vermont-station) + (dun-mprincl + "The explosion causes a hole to open up in the ground, which you fall + through."))))) + + (if (and (= objnum obj-weight) (= dun-current-room maze-button-room)) + (dun-mprincl "A passageway opens."))) + + ;;; Give long description of current room, or an object. + + (defun dun-examine (obj) + (let (objnum) + (setq objnum (dun-objnum-from-args obj)) + (if (eq objnum obj-special) + (dun-describe-room (* dun-current-room -1)) + (if (and (eq objnum obj-computer) + (member obj-pc (nth dun-current-room dun-room-silents))) + (dun-examine '("pc")) + (if (eq objnum nil) + (dun-mprincl "I don't know what that is.") + (if (and (not (member objnum + (nth dun-current-room dun-room-objects))) + (not (member objnum + (nth dun-current-room dun-room-silents))) + (not (member objnum dun-inventory))) + (dun-mprincl "I don't see that here.") + (if (>= objnum 0) + (if (and (= objnum obj-bone) + (= dun-current-room marine-life-area) dun-black) + (dun-mprincl + "In this light you can see some writing on the bone. It says: + For an explosive time, go to Fourth St. and Vermont.") + (if (nth objnum dun-physobj-desc) + (dun-mprincl (nth objnum dun-physobj-desc)) + (dun-mprincl "I see nothing special about that."))) + (if (nth (abs objnum) dun-permobj-desc) + (progn + (dun-mprincl (nth (abs objnum) dun-permobj-desc))) + (dun-mprincl "I see nothing special about that."))))))))) + + (defun dun-take (obj) + (if dun-inbus + (dun-mprincl "You can't take anything while on the bus.") + (setq obj (dun-firstword obj)) + (if (not obj) + (dun-mprincl "You must supply an object.") + (if (string= obj "all") + (let (gotsome) + (setq gotsome nil) + (dolist (x (nth dun-current-room dun-room-objects)) + (if (and (>= x 0) (not (= x obj-special))) + (progn + (setq gotsome t) + (dun-mprinc (cadr (nth x dun-objects))) + (dun-mprinc ": ") + (dun-take-object x)))) + (if (not gotsome) + (dun-mprincl "Nothing to take."))) + (let (objnum) + (setq objnum (cdr (assq (intern obj) dun-objnames))) + (if (eq objnum nil) + (progn + (dun-mprinc "I don't know what that is.") + (dun-mprinc "\n")) + (dun-take-object objnum))))))) + + (defun dun-take-object (objnum) + (if (and (member objnum dun-jar) (member obj-jar dun-inventory)) + (let (newjar) + (dun-mprincl "You remove it from the jar.") + (setq newjar nil) + (dolist (x dun-jar) + (if (not (= x objnum)) + (setq newjar (append newjar (list x))))) + (setq dun-jar newjar) + (setq dun-inventory (append dun-inventory (list objnum)))) + (if (not (member objnum (nth dun-current-room dun-room-objects))) + (if (not (member objnum (nth dun-current-room dun-room-silents))) + (dun-mprinc "I do not see that here.") + (dun-try-take objnum)) + (if (>= objnum 0) + (progn + (if (and (car dun-inventory) + (> (+ (dun-inven-weight) (nth objnum dun-object-lbs)) 11)) + (dun-mprinc "Your load would be too heavy.") + (setq dun-inventory (append dun-inventory (list objnum))) + (dun-remove-obj-from-room dun-current-room objnum) + (dun-mprinc "Taken. ") + (if (and (= objnum obj-towel) (= dun-current-room red-room)) + (dun-mprinc + "Taking the towel reveals a hole in the floor.")))) + (dun-try-take objnum))) + (dun-mprinc "\n"))) + + (defun dun-inven-weight () + (let (total) + (setq total 0) + (dolist (x dun-jar) + (setq total (+ total (nth x dun-object-lbs)))) + (dolist (x dun-inventory) + (setq total (+ total (nth x dun-object-lbs)))) total)) + + ;;; We try to take an object that is untakable. Print a message + ;;; depending on what it is. + + (defun dun-try-take (obj) + (dun-mprinc "You cannot take that.")) + + (defun dun-dig (args) + (if dun-inbus + (dun-mprincl "You can't dig while on the bus.") + (if (not (member 0 dun-inventory)) + (dun-mprincl "You have nothing with which to dig.") + (if (not (nth dun-current-room dun-diggables)) + (dun-mprincl "Digging here reveals nothing.") + (dun-mprincl "I think you found something.") + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (nth dun-current-room dun-diggables))) + (dun-replace dun-diggables dun-current-room nil))))) + + (defun dun-climb (obj) + (let (objnum) + (setq objnum (dun-objnum-from-args obj)) + (if (and (not (= objnum obj-special)) + (not (member objnum (nth dun-current-room dun-room-objects))) + (not (member objnum (nth dun-current-room dun-room-silents))) + (not (member objnum dun-inventory))) + (dun-mprincl "I don't see that here.") + (if (and (= objnum obj-special) + (not (member obj-tree (nth dun-current-room dun-room-silents)))) + (dun-mprincl "There is nothing here to climb.") + (if (and (not (= objnum obj-tree)) (not (= objnum obj-special))) + (dun-mprincl "You can't climb that.") + (dun-mprincl + "You manage to get about two feet up the tree and fall back down. You + notice that the tree is very unsteady.")))))) + + (defun dun-eat (obj) + (let (objnum) + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (not (member objnum dun-inventory)) + (dun-mprincl "You don't have that.") + (if (not (= objnum obj-food)) + (progn + (dun-mprinc "You forcefully shove ") + (dun-mprinc (downcase (cadr (nth objnum dun-objects)))) + (dun-mprincl " down your throat, and start choking.") + (dun-die "choking")) + (dun-mprincl "That tasted horrible.") + (dun-remove-obj-from-inven obj-food)))))) + + (defun dun-put (args) + (if dun-inbus + (dun-mprincl "You can't do that while on the bus") + (let (newargs objnum objnum2 obj) + (setq newargs (dun-firstwordl args)) + (if (not newargs) + (dun-mprincl "You must supply an object") + (setq obj (intern (car newargs))) + (setq objnum (cdr (assq obj dun-objnames))) + (if (not objnum) + (dun-mprincl "I don't know what that object is.") + (if (not (member objnum dun-inventory)) + (dun-mprincl "You don't have that.") + (setq newargs (dun-firstwordl (cdr newargs))) + (setq newargs (dun-firstwordl (cdr newargs))) + (if (not newargs) + (dun-mprincl "You must supply an indirect object.") + (setq objnum2 (cdr (assq (intern (car newargs)) dun-objnames))) + (if (and (eq objnum2 obj-computer) (= dun-current-room pc-area)) + (setq objnum2 obj-pc)) + (if (not objnum2) + (dun-mprincl "I don't know what that indirect object is.") + (if (and (not (member objnum2 + (nth dun-current-room dun-room-objects))) + (not (member objnum2 + (nth dun-current-room dun-room-silents))) + (not (member objnum2 dun-inventory))) + (dun-mprincl "That indirect object is not here.") + (dun-put-objs objnum objnum2)))))))))) + + (defun dun-put-objs (obj1 obj2) + (if (and (= obj2 obj-drop) (not dun-nomail)) + (setq obj2 obj-chute)) + + (if (= obj2 obj-disposal) (setq obj2 obj-chute)) + + (if (and (= obj1 obj-cpu) (= obj2 obj-computer)) + (progn + (dun-remove-obj-from-inven obj-cpu) + (setq dun-computer t) + (dun-mprincl + "As you put the CPU board in the computer, it immediately springs to life. + The lights start flashing, and the fans seem to startup.")) + (if (and (= obj1 obj-weight) (= obj2 obj-button)) + (dun-drop '("weight")) + (if (= obj2 obj-jar) ;; Put something in jar + (if (not (member obj1 (list obj-paper obj-diamond obj-emerald + obj-license obj-coins obj-egg + obj-nitric obj-glycerine))) + (dun-mprincl "That will not fit in the jar.") + (dun-remove-obj-from-inven obj1) + (setq dun-jar (append dun-jar (list obj1))) + (dun-mprincl "Done.")) + (if (= obj2 obj-chute) ;; Put something in chute + (progn + (dun-remove-obj-from-inven obj1) + (dun-mprincl + "You hear it slide down the chute and off into the distance.") + (dun-put-objs-in-treas (list obj1))) + (if (= obj2 obj-box) ;; Put key in key box + (if (= obj1 obj-key) + (progn + (dun-mprincl + "As you drop the key, the box begins to shake. Finally it explodes + with a bang. The key seems to have vanished!") + (dun-remove-obj-from-inven obj1) + (dun-replace dun-room-objects computer-room (append + (nth computer-room + dun-room-objects) + (list obj1))) + (dun-remove-obj-from-room dun-current-room obj-box) + (setq dun-key-level (1+ dun-key-level))) + (dun-mprincl "You can't put that in the key box!")) + + (if (and (= obj1 obj-floppy) (= obj2 obj-pc)) + (progn + (setq dun-floppy t) + (dun-remove-obj-from-inven obj1) + (dun-mprincl "Done.")) + + (if (= obj2 obj-urinal) ;; Put object in urinal + (progn + (dun-remove-obj-from-inven obj1) + (dun-replace dun-room-objects urinal (append + (nth urinal dun-room-objects) + (list obj1))) + (dun-mprincl + "You hear it plop down in some water below.")) + (if (= obj2 obj-mail) + (dun-mprincl "The mail chute is locked.") + (if (member obj1 dun-inventory) + (dun-mprincl + "I don't know how to combine those objects. Perhaps you should + just try dropping it.") + (dun-mprincl"You can't put that there."))))))))))) + + (defun dun-type (args) + (if (not (= dun-current-room computer-room)) + (dun-mprincl "There is nothing here on which you could type.") + (if (not dun-computer) + (dun-mprincl + "You type on the keyboard, but your characters do not even echo.") + (dun-unix-interface)))) + + ;;; Various movement directions + + (defun dun-n (args) + (dun-move north)) + + (defun dun-s (args) + (dun-move south)) + + (defun dun-e (args) + (dun-move east)) + + (defun dun-w (args) + (dun-move west)) + + (defun dun-ne (args) + (dun-move northeast)) + + (defun dun-se (args) + (dun-move southeast)) + + (defun dun-nw (args) + (dun-move northwest)) + + (defun dun-sw (args) + (dun-move southwest)) + + (defun dun-up (args) + (dun-move up)) + + (defun dun-down (args) + (dun-move down)) + + (defun dun-in (args) + (dun-move in)) + + (defun dun-out (args) + (dun-move out)) + + (defun dun-go (args) + (if (or (not (car args)) + (eq (dun-doverb dun-ignore dun-verblist (car args) + (cdr (cdr args))) -1)) + (dun-mprinc "I don't understand where you want me to go.\n"))) + + ;;; Uses the dungeon-map to figure out where we are going. If the + ;;; requested direction yields 255, we know something special is + ;;; supposed to happen, or perhaps you can't go that way unless + ;;; certain conditions are met. + + (defun dun-move (dir) + (if (and (not (member dun-current-room dun-light-rooms)) + (not (member obj-lamp dun-inventory))) + (progn + (dun-mprinc + "You trip over a grue and fall into a pit and break every bone in your + body.") + (dun-die "a grue")) + (let (newroom) + (setq newroom (nth dir (nth dun-current-room dungeon-map))) + (if (eq newroom -1) + (dun-mprinc "You can't go that way.\n") + (if (eq newroom 255) + (dun-special-move dir) + (setq room -1) + (setq dun-lastdir dir) + (if dun-inbus + (progn + (if (or (< newroom 58) (> newroom 83)) + (dun-mprincl "The bus cannot go this way.") + (dun-mprincl + "The bus lurches ahead and comes to a screeching halt.") + (dun-remove-obj-from-room dun-current-room obj-bus) + (setq dun-current-room newroom) + (dun-replace dun-room-objects newroom + (append (nth newroom dun-room-objects) + (list obj-bus))))) + (setq dun-current-room newroom))))))) + + ;;; Movement in this direction causes something special to happen if the + ;;; right conditions exist. It may be that you can't go this way unless + ;;; you have a key, or a passage has been opened. + + ;;; coding note: Each check of the current room is on the same 'if' level, + ;;; i.e. there aren't else's. If two rooms next to each other have + ;;; specials, and they are connected by specials, this could cause + ;;; a problem. Be careful when adding them to consider this, and + ;;; perhaps use else's. + + (defun dun-special-move (dir) + (if (= dun-current-room building-front) + (if (not (member obj-key dun-inventory)) + (dun-mprincl "You don't have a key that can open this door.") + (setq dun-current-room old-building-hallway)) + (if (= dun-current-room north-end-of-cave-passage) + (let (combo) + (dun-mprincl + "You must type a 3 digit combination code to enter this room.") + (dun-mprinc "Enter it here: ") + (setq combo (dun-read-line)) + (if (not dun-batch-mode) + (dun-mprinc "\n")) + (if (string= combo dun-combination) + (setq dun-current-room gamma-computing-center) + (dun-mprincl "Sorry, that combination is incorrect.")))) + + (if (= dun-current-room bear-hangout) + (if (member obj-bear (nth bear-hangout dun-room-objects)) + (progn + (dun-mprinc + "The bear is very annoyed that you would be so presumptuous as to try + and walk right by it. He tells you so by tearing your head off. + ") + (dun-die "a bear")) + (dun-mprincl "You can't go that way."))) + + (if (= dun-current-room vermont-station) + (progn + (dun-mprincl + "As you board the train it immediately leaves the station. It is a very + bumpy ride. It is shaking from side to side, and up and down. You + sit down in one of the chairs in order to be more comfortable.") + (dun-mprincl + "\nFinally the train comes to a sudden stop, and the doors open, and some + force throws you out. The train speeds away.\n") + (setq dun-current-room museum-station))) + + (if (= dun-current-room old-building-hallway) + (if (and (member obj-key dun-inventory) + (> dun-key-level 0)) + (setq dun-current-room meadow) + (dun-mprincl "You don't have a key that can open this door."))) + + (if (and (= dun-current-room maze-button-room) (= dir northwest)) + (if (member obj-weight (nth maze-button-room dun-room-objects)) + (setq dun-current-room 18) + (dun-mprincl "You can't go that way."))) + + (if (and (= dun-current-room maze-button-room) (= dir up)) + (if (member obj-weight (nth maze-button-room dun-room-objects)) + (dun-mprincl "You can't go that way.") + (setq dun-current-room weight-room))) + + (if (= dun-current-room classroom) + (dun-mprincl "The door is locked.")) + + (if (or (= dun-current-room lakefront-north) + (= dun-current-room lakefront-south)) + (dun-swim nil)) + + (if (= dun-current-room reception-area) + (if (not (= dun-sauna-level 3)) + (setq dun-current-room health-club-front) + (dun-mprincl + "As you exit the building, you notice some flames coming out of one of the + windows. Suddenly, the building explodes in a huge ball of fire. The flames + engulf you, and you burn to death.") + (dun-die "burning"))) + + (if (= dun-current-room red-room) + (if (not (member obj-towel (nth red-room dun-room-objects))) + (setq dun-current-room long-n-s-hallway) + (dun-mprincl "You can't go that way."))) + + (if (and (> dir down) (> dun-current-room gamma-computing-center) + (< dun-current-room museum-lobby)) + (if (not (member obj-bus (nth dun-current-room dun-room-objects))) + (dun-mprincl "You can't go that way.") + (if (= dir in) + (if (member obj-license dun-inventory) + (progn + (dun-mprincl + "You board the bus and get in the driver's seat.") + (setq dun-nomail t) + (setq dun-inbus t)) + (dun-mprincl "You are not licensed for this type of vehicle.")) + (dun-mprincl "You hop off the bus.") + (setq dun-inbus nil))) + (if (= dun-current-room fifth-oaktree-intersection) + (if (not dun-inbus) + (progn + (dun-mprincl "You fall down the cliff and land on your head.") + (dun-die "a cliff")) + (dun-mprincl + "The bus flies off the cliff, and plunges to the bottom, where it explodes.") + (dun-die "a bus accident"))) + (if (= dun-current-room main-maple-intersection) + (progn + (if (not dun-inbus) + (dun-mprincl "The gate will not open.") + (dun-mprincl + "As the bus approaches, the gate opens and you drive through.") + (dun-remove-obj-from-room main-maple-intersection obj-bus) + (dun-replace dun-room-objects museum-entrance + (append (nth museum-entrance dun-room-objects) + (list obj-bus))) + (setq dun-current-room museum-entrance))))) + (if (= dun-current-room cave-entrance) + (progn + (dun-mprincl + "As you enter the room you hear a rumbling noise. You look back to see + huge rocks sliding down from the ceiling, and blocking your way out.\n") + (setq dun-current-room misty-room))))) + + (defun dun-long (args) + (setq dun-mode "long")) + + (defun dun-turn (obj) + (let (objnum direction) + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (not (or (member objnum (nth dun-current-room dun-room-objects)) + (member objnum (nth dun-current-room dun-room-silents)))) + (dun-mprincl "I don't see that here.") + (if (not (= objnum obj-dial)) + (dun-mprincl "You can't turn that.") + (setq direction (dun-firstword (cdr obj))) + (if (or (not direction) + (not (or (string= direction "clockwise") + (string= direction "counterclockwise")))) + (dun-mprincl "You must indicate clockwise or counterclockwise.") + (if (string= direction "clockwise") + (setq dun-sauna-level (+ dun-sauna-level 1)) + (setq dun-sauna-level (- dun-sauna-level 1))) + + (if (< dun-sauna-level 0) + (progn + (dun-mprincl + "The dial will not turn further in that direction.") + (setq dun-sauna-level 0)) + (dun-sauna-heat)))))))) + + (defun dun-sauna-heat () + (if (= dun-sauna-level 0) + (dun-mprincl + "The termperature has returned to normal room termperature.")) + (if (= dun-sauna-level 1) + (dun-mprincl "It is now luke warm in here. You begin to sweat.")) + (if (= dun-sauna-level 2) + (dun-mprincl "It is pretty hot in here. It is still very comfortable.")) + (if (= dun-sauna-level 3) + (progn + (dun-mprincl + "It is now very hot. There is something very refreshing about this.") + (if (or (member obj-rms dun-inventory) + (member obj-rms (nth dun-current-room dun-room-objects))) + (progn + (dun-mprincl + "You notice the wax on your statuette beginning to melt, until it completely + melts off. You are left with a beautiful diamond!") + (if (member obj-rms dun-inventory) + (progn + (dun-remove-obj-from-inven obj-rms) + (setq dun-inventory (append dun-inventory + (list obj-diamond)))) + (dun-remove-obj-from-room dun-current-room obj-rms) + (dun-replace dun-room-objects dun-current-room + (append (nth dun-current-room dun-room-objects) + (list obj-diamond)))))) + (if (or (member obj-floppy dun-inventory) + (member obj-floppy (nth dun-current-room dun-room-objects))) + (progn + (dun-mprincl + "You notice your floppy disk beginning to melt. As you grab for it, the + disk bursts into flames, and disintegrates.") + (if (member obj-floppy dun-inventory) + (dun-remove-obj-from-inven obj-floppy) + (dun-remove-obj-from-room dun-current-room obj-floppy)))))) + + (if (= dun-sauna-level 4) + (progn + (dun-mprincl + "As the dial clicks into place, you immediately burst into flames.") + (dun-die "burning")))) + + (defun dun-press (obj) + (let (objnum) + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (not (or (member objnum (nth dun-current-room dun-room-objects)) + (member objnum (nth dun-current-room dun-room-silents)))) + (dun-mprincl "I don't see that here.") + (if (not (member objnum (list obj-button obj-switch))) + (progn + (dun-mprinc "You can't ") + (dun-mprinc (car line-list)) + (dun-mprincl " that.")) + (if (= objnum obj-button) + (dun-mprincl + "As you press the button, you notice a passageway open up, but + as you release it, the passageway closes.")) + (if (= objnum obj-switch) + (if dun-black + (progn + (dun-mprincl "The button is now in the off position.") + (setq dun-black nil)) + (dun-mprincl "The button is now in the on position.") + (setq dun-black t)))))))) + + (defun dun-swim (args) + (if (not (member dun-current-room (list lakefront-north lakefront-south))) + (dun-mprincl "I see no water!") + (if (not (member obj-life dun-inventory)) + (progn + (dun-mprincl + "You dive in the water, and at first notice it is quite cold. You then + start to get used to it as you realize that you never really learned how + to swim.") + (dun-die "drowning")) + (if (= dun-current-room lakefront-north) + (setq dun-current-room lakefront-south) + (setq dun-current-room lakefront-north))))) + + + (defun dun-score (args) + (if (not dun-endgame) + (let (total) + (setq total (dun-reg-score)) + (dun-mprinc "You have scored ") + (dun-mprinc total) + (dun-mprincl " out of a possible 90 points.") total) + (dun-mprinc "You have scored ") + (dun-mprinc (dun-endgame-score)) + (dun-mprincl " endgame points out of a possible 110.") + (if (= (dun-endgame-score) 110) + (dun-mprincl + "\n\nCongratulations. You have won. The wizard password is 'moby'")))) + + (defun dun-help (args) + (dun-mprincl + "Welcome to dunnet (2.0), by Ron Schnell (ronnie@media.mit.edu). + Here is some useful information (read carefully because there are one + or more clues in here): + - If you have a key that can open a door, you do not need to explicitly + open it. You may just use 'in' or walk in the direction of the door. + + - If you have a lamp, it is always lit. + + - You will not get any points until you manage to get treasures to a certain + place. Simply finding the treasures is not good enough. There is more + than one way to get a treasure to the special place. It is also + important that the objects get to the special place *unharmed* and + *untarnished*. You can tell if you have successfully transported the + object by looking at your score, as it changes immediately. Note that + an object can become harmed even after you have received points for it. + If this happens, your score will decrease, and in many cases you can never + get credit for it again. + + - You can save your game with the 'save' command, and use restore it + with the 'restore' command. + + - There are no limits on lengths of object names. + + - Directions are: north,south,east,west,northeast,southeast,northwest, + southwest,up,down,in,out. + + - These can be abbreviated: n,s,e,w,ne,se,nw,sw,u,d,in,out. + + - If you go down a hole in the floor without an aid such as a ladder, + you probably won't be able to get back up the way you came, if at all. + + - To run this game in batch mode (no emacs window), use: + emacs -batch -l dunnet + + If you have questions or comments, please contact ronnie@media.mit.edu.")) + + (defun dun-flush (args) + (if (not (= dun-current-room bathroom)) + (dun-mprincl "I see nothing to flush.") + (dun-mprincl "Whoooosh!!") + (dun-put-objs-in-treas (nth urinal dun-room-objects)) + (dun-replace dun-room-objects urinal nil))) + + (defun dun-piss (args) + (if (not (= dun-current-room bathroom)) + (dun-mprincl "You can't do that here, don't even bother trying.") + (if (not dun-gottago) + (dun-mprincl "I'm afraid you don't have to go now.") + (dun-mprincl "That was refreshing.") + (setq dun-gottago nil) + (dun-replace dun-room-objects urinal (append + (nth urinal dun-room-objects) + (list obj-URINE)))))) + + + (defun dun-sleep (args) + (if (not (= dun-current-room bedroom)) + (dun-mprincl + "You try to go to sleep while standing up here, but can't seem to do it.") + (setq dun-gottago t) + (dun-mprincl + "As soon as you start to doze off you begin dreaming. You see images of + workers digging caves, slaving in the humid heat. Then you see yourself + as one of these workers. While no one is looking, you leave the group + and walk into a room. The room is bare except for a horseshoe + shaped piece of stone in the center. You see yourself digging a hole in + the ground, then putting some kind of treasure in it, and filling the hole + with dirt again. After this, you immediately wake up."))) + + (defun dun-break (obj) + (let (objnum) + (if (not (member obj-axe dun-inventory)) + (dun-mprincl "You have nothing you can use to break things.") + (when (setq objnum (dun-objnum-from-args-std obj)) + (if (member objnum dun-inventory) + (progn + (dun-mprincl + "You take the object in your hands and swing the axe. Unfortunately, you miss + the object and slice off your hand. You bleed to death.") + (dun-die "an axe")) + (if (not (or (member objnum (nth dun-current-room dun-room-objects)) + (member objnum + (nth dun-current-room dun-room-silents)))) + (dun-mprincl "I don't see that here.") + (if (= objnum obj-cable) + (progn + (dun-mprincl + "As you break the ethernet cable, everything starts to blur. You collapse + for a moment, then straighten yourself up. + ") + (dun-replace dun-room-objects gamma-computing-center + (append + (nth gamma-computing-center dun-room-objects) + dun-inventory)) + (if (member obj-key dun-inventory) + (progn + (setq dun-inventory (list obj-key)) + (dun-remove-obj-from-room + gamma-computing-center obj-key)) + (setq dun-inventory nil)) + (setq dun-current-room computer-room) + (setq dun-ethernet nil) + (dun-mprincl "Connection closed.") + (dun-unix-interface)) + (if (< objnum 0) + (progn + (dun-mprincl "Your axe shatters into a million pieces.") + (dun-remove-obj-from-inven obj-axe)) + (dun-mprincl "Your axe breaks it into a million pieces.") + (dun-remove-obj-from-room dun-current-room objnum))))))))) + + (defun dun-drive (args) + (if (not dun-inbus) + (dun-mprincl "You cannot drive when you aren't in a vehicle.") + (dun-mprincl "To drive while you are in the bus, just give a direction."))) + + (defun dun-superb (args) + (setq dun-mode 'dun-superb)) + + (defun dun-reg-score () + (let (total) + (setq total 0) + (dolist (x (nth treasure-room dun-room-objects)) + (setq total (+ total (nth x dun-object-pts)))) + (if (member obj-URINE (nth treasure-room dun-room-objects)) + (setq total 0)) total)) + + (defun dun-endgame-score () + (let (total) + (setq total 0) + (dolist (x (nth endgame-treasure-room dun-room-objects)) + (setq total (+ total (nth x dun-object-pts)))) total)) + + (defun dun-answer (args) + (if (not dun-correct-answer) + (dun-mprincl "I don't believe anyone asked you anything.") + (setq args (car args)) + (if (not args) + (dun-mprincl "You must give the answer on the same line.") + (if (dun-members args dun-correct-answer) + (progn + (dun-mprincl "Correct.") + (if (= dun-lastdir 0) + (setq dun-current-room (1+ dun-current-room)) + (setq dun-current-room (- dun-current-room 1))) + (setq dun-correct-answer nil)) + (dun-mprincl "That answer is incorrect."))))) + + (defun dun-endgame-question () + (if (not dun-endgame-questions) + (progn + (dun-mprincl "Your question is:") + (dun-mprincl "No more questions, just do 'answer foo'.") + (setq dun-correct-answer '("foo"))) + (let (which i newques) + (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 + (nth which + dun-endgame-questions)))) + (setq dun-correct-answer (cdr (nth which dun-endgame-questions))) + (while (< i which) + (setq newques (append newques (list (nth i dun-endgame-questions)))) + (setq i (1+ i))) + (setq i (1+ which)) + (while (< i (length dun-endgame-questions)) + (setq newques (append newques (list (nth i dun-endgame-questions)))) + (setq i (1+ i))) + (setq dun-endgame-questions newques)))) + + (defun dun-power (args) + (if (not (= dun-current-room pc-area)) + (dun-mprincl "That operation is not applicable here.") + (if (not dun-floppy) + (dun-dos-no-disk) + (dun-dos-interface)))) + + (defun dun-feed (args) + (let (objnum) + (when (setq objnum (dun-objnum-from-args-std args)) + (if (and (= objnum obj-bear) + (member obj-bear (nth dun-current-room dun-room-objects))) + (progn + (if (not (member obj-food dun-inventory)) + (dun-mprincl "You have nothing with which to feed it.") + (dun-drop '("food")))) + (if (not (or (member objnum (nth dun-current-room dun-room-objects)) + (member objnum dun-inventory) + (member objnum (nth dun-current-room dun-room-silents)))) + (dun-mprincl "I don't see that here.") + (dun-mprincl "You cannot feed that.")))))) + + + ;;;; + ;;;; This section defines various utility functions used + ;;;; by dunnet. + ;;;; + + + ;;; Function which takes a verb and a list of other words. Calls proper + ;;; function associated with the verb, and passes along the other words. + + (defun dun-doverb (dun-ignore dun-verblist verb rest) + (if (not verb) + nil + (if (member (intern verb) dun-ignore) + (if (not (car rest)) -1 + (dun-doverb dun-ignore dun-verblist (car rest) (cdr rest))) + (if (not (cdr (assq (intern verb) dun-verblist))) -1 + (setq dun-numcmds (1+ dun-numcmds)) + (eval (list (cdr (assq (intern verb) dun-verblist)) (quote rest))))))) + + + ;;; Function to take a string and change it into a list of lowercase words. + + (defun dun-listify-string (strin) + (let (pos ret-list end-pos) + (setq pos 0) + (setq ret-list nil) + (while (setq end-pos (string-match "[ ,:;]" (substring strin pos))) + (setq end-pos (+ end-pos pos)) + (if (not (= end-pos pos)) + (setq ret-list (append ret-list (list + (downcase + (substring strin pos end-pos)))))) + (setq pos (+ end-pos 1))) ret-list)) + + (defun dun-listify-string2 (strin) + (let (pos ret-list end-pos) + (setq pos 0) + (setq ret-list nil) + (while (setq end-pos (string-match " " (substring strin pos))) + (setq end-pos (+ end-pos pos)) + (if (not (= end-pos pos)) + (setq ret-list (append ret-list (list + (downcase + (substring strin pos end-pos)))))) + (setq pos (+ end-pos 1))) ret-list)) + + (defun dun-replace (list n number) + (rplaca (nthcdr n list) number)) + + + ;;; Get the first non-ignored word from a list. + + (defun dun-firstword (list) + (if (not (car list)) + nil + (while (and list (member (intern (car list)) dun-ignore)) + (setq list (cdr list))) + (car list))) + + (defun dun-firstwordl (list) + (if (not (car list)) + nil + (while (and list (member (intern (car list)) dun-ignore)) + (setq list (cdr list))) + list)) + + ;;; parse a line passed in as a string Call the proper verb with the + ;;; rest of the line passed in as a list. + + (defun dun-vparse (dun-ignore dun-verblist line) + (dun-mprinc "\n") + (setq line-list (dun-listify-string (concat line " "))) + (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) + + (defun dun-parse2 (dun-ignore dun-verblist line) + (dun-mprinc "\n") + (setq line-list (dun-listify-string2 (concat line " "))) + (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) + + ;;; Read a line, in window mode + + (defun dun-read-line () + (let (line) + (setq line (read-string "")) + (dun-mprinc line) line)) + + ;;; Insert something into the window buffer + + (defun dun-minsert (string) + (if (stringp string) + (insert string) + (insert (prin1-to-string string)))) + + ;;; Print something out, in window mode + + (defun dun-mprinc (string) + (if (stringp string) + (insert string) + (insert (prin1-to-string string)))) + + ;;; In window mode, keep screen from jumping by keeping last line at + ;;; the bottom of the screen. + + (defun dun-fix-screen () + (interactive) + (forward-line (- 0 (- (window-height) 2 ))) + (set-window-start (selected-window) (point)) + (end-of-buffer)) + + ;;; Insert something into the buffer, followed by newline. + + (defun dun-minsertl (string) + (dun-minsert string) + (dun-minsert "\n")) + + ;;; Print something, followed by a newline. + + (defun dun-mprincl (string) + (dun-mprinc string) + (dun-mprinc "\n")) + + ;;; Function which will get an object number given the list of + ;;; words in the command, except for the verb. + + (defun dun-objnum-from-args (obj) + (let (objnum) + (setq obj (dun-firstword obj)) + (if (not obj) + obj-special + (setq objnum (cdr (assq (intern obj) dun-objnames)))))) + + (defun dun-objnum-from-args-std (obj) + (let (result) + (if (eq (setq result (dun-objnum-from-args obj)) obj-special) + (dun-mprincl "You must supply an object.")) + (if (eq result nil) + (dun-mprincl "I don't know what that is.")) + (if (eq result obj-special) + nil + result))) + + ;;; Take a short room description, and change spaces and slashes to dashes. + + (defun dun-space-to-hyphen (string) + (let (space) + (if (setq space (string-match "[ /]" string)) + (progn + (setq string (concat (substring string 0 space) "-" + (substring string (1+ space)))) + (dun-space-to-hyphen string)) + string))) + + ;;; Given a unix style pathname, build a list of path components (recursive) + + (defun dun-get-path (dirstring startlist) + (let (slash pos) + (if (= (length dirstring) 0) + startlist + (if (string= (substring dirstring 0 1) "/") + (dun-get-path (substring dirstring 1) (append startlist (list "/"))) + (if (not (setq slash (string-match "/" dirstring))) + (append startlist (list dirstring)) + (dun-get-path (substring dirstring (1+ slash)) + (append startlist + (list (substring dirstring 0 slash))))))))) + + + ;;; Is a string a member of a string list? + + (defun dun-members (string string-list) + (let (found) + (setq found nil) + (dolist (x string-list) + (if (string= x string) + (setq found t))) found)) + + ;;; Function to put objects in the treasure room. Also prints current + ;;; score to let user know he has scored. + + (defun dun-put-objs-in-treas (objlist) + (let (oscore newscore) + (setq oscore (dun-reg-score)) + (dun-replace dun-room-objects 0 (append (nth 0 dun-room-objects) objlist)) + (setq newscore (dun-reg-score)) + (if (not (= oscore newscore)) + (dun-score nil)))) + + ;;; Load an encrypted file, and eval it. + + (defun dun-load-d (filename) + (let (old-buffer result) + (setq result t) + (setq old-buffer (current-buffer)) + (switch-to-buffer (get-buffer-create "*loadc*")) + (erase-buffer) + (condition-case nil + (insert-file-contents filename) + (error (setq result nil))) + (unless (not result) + (condition-case nil + (dun-rot13) + (error (yank))) + (eval-current-buffer) + (kill-buffer (current-buffer)) + (switch-to-buffer old-buffer)) + result)) + + ;;; Functions to remove an object either from a room, or from inventory. + + (defun dun-remove-obj-from-room (room objnum) + (let (newroom) + (setq newroom nil) + (dolist (x (nth room dun-room-objects)) + (if (not (= x objnum)) + (setq newroom (append newroom (list x))))) + (rplaca (nthcdr room dun-room-objects) newroom))) + + (defun dun-remove-obj-from-inven (objnum) + (let (new-inven) + (setq new-inven nil) + (dolist (x dun-inventory) + (if (not (= x objnum)) + (setq new-inven (append new-inven (list x))))) + (setq dun-inventory new-inven))) + + + (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper) + (setq dun-translate-table (make-vector 256 0)) + (while (< i 256) + (aset dun-translate-table i i) + (setq i (1+ i))) + (setq lower (concat lower lower)) + (setq upper (upcase lower)) + (setq i 0) + (while (< i 26) + (aset dun-translate-table (+ ?a i) (aref lower (+ i 13))) + (aset dun-translate-table (+ ?A i) (aref upper (+ i 13))) + (setq i (1+ i)))) + + (defun dun-rot13 () + (let (str len (i 0)) + (setq str (buffer-substring (point-min) (point-max))) + (setq len (length str)) + (while (< i len) + (aset str i (aref dun-translate-table (aref str i))) + (setq i (1+ i))) + (erase-buffer) + (insert str))) + + ;;;; + ;;;; This section defines the globals that are used in dunnet. + ;;;; + ;;;; IMPORTANT + ;;;; All globals which can change must be saved from 'save-game. Add + ;;;; all new globals to bottom of file. + + (setq dun-visited '(27)) + (setq dun-current-room 1) + (setq dun-exitf nil) + (setq dun-badcd nil) + (defvar dungeon-mode-map nil) + (setq dungeon-mode-map (make-sparse-keymap)) + (define-key dungeon-mode-map "\r" 'dun-parse) + (defvar dungeon-batch-map (make-keymap)) + (if (string= (substring emacs-version 0 2) "18") + (let (n) + (setq n 32) + (while (< 0 (setq n (- n 1))) + (aset dungeon-batch-map n 'dungeon-nil))) + (let (n) + (setq n 32) + (while (< 0 (setq n (- n 1))) + (aset (car (cdr dungeon-batch-map)) n 'dungeon-nil)))) + (define-key dungeon-batch-map "\r" 'exit-minibuffer) + (define-key dungeon-batch-map "\n" 'exit-minibuffer) + (setq dun-computer nil) + (setq dun-floppy nil) + (setq dun-key-level 0) + (setq dun-hole nil) + (setq dun-correct-answer nil) + (setq dun-lastdir 0) + (setq dun-numsaves 0) + (setq dun-jar nil) + (setq dun-dead nil) + (setq room 0) + (setq dun-numcmds 0) + (setq dun-wizard nil) + (setq dun-endgame-question nil) + (setq dun-logged-in nil) + (setq dungeon-mode 'dungeon) + (setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) + (exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd) + (rlogin . dun-rlogin) (uncompress . dun-uncompress) + (cat . dun-cat) (zippy . dun-zippy))) + + (setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type) + (exit . dun-dos-exit) (command . dun-dos-spawn) + (b: . dun-dos-invd) (c: . dun-dos-invd) + (a: . dun-dos-nil))) + + + (setq dun-batch-mode nil) + + (setq dun-cdpath "/usr/toukmond") + (setq dun-cdroom -10) + (setq dun-uncompressed nil) + (setq dun-ethernet t) + (setq dun-restricted + '(dun-room-objects dungeon-map dun-rooms + dun-room-silents dun-combination)) + (setq dun-ftptype 'ascii) + (setq dun-endgame nil) + (setq dun-gottago t) + (setq dun-black nil) + + (setq dun-rooms '( + ( + "You are in the treasure room. A door leads out to the north." + "Treasure room" + ) + ( + "You are at a dead end of a dirt road. The road goes to the east. + In the distance you can see that it will eventually fork off. The + trees here are very tall royal palms, and they are spaced equidistant + from each other." + "Dead end" + ) + ( + "You are on the continuation of a dirt road. There are more trees on + both sides of you. The road continues to the east and west." + "E/W Dirt road" + ) + ( + "You are at a fork of two passages, one to the northeast, and one to the + southeast. The ground here seems very soft. You can also go back west." + "Fork" + ) + ( + "You are on a northeast/southwest road." + "NE/SW road" + ) + ( + "You are at the end of the road. There is a building in front of you + to the northeast, and the road leads back to the southwest." + "Building front" + ) + ( + "You are on a southeast/northwest road." + "SE/NW road" + ) + ( + "You are standing at the end of a road. A passage leads back to the + northwest." + "Bear hangout" + ) + ( + "You are in the hallway of an old building. There are rooms to the east + and west, and doors leading out to the north and south." + "Old Building hallway" + ) + ( + "You are in a mailroom. There are many bins where the mail is usually + kept. The exit is to the west." + "Mailroom" + ) + ( + "You are in a computer room. It seems like most of the equipment has + been removed. There is a VAX 11/780 in front of you, however, with + one of the cabinets wide open. A sign on the front of the machine + says: This VAX is named 'pokey'. To type on the console, use the + 'type' command. The exit is to the east." + "Computer room" + ) + ( + "You are in a meadow in the back of an old building. A small path leads + to the west, and a door leads to the south." + "Meadow" + ) + ( + "You are in a round, stone room with a door to the east. There + is a sign on the wall that reads: 'receiving room'." + "Receiving room" + ) + ( + "You are at the south end of a hallway that leads to the north. There + are rooms to the east and west." + "Northbound Hallway" + ) + ( + "You are in a sauna. There is nothing in the room except for a dial + on the wall. A door leads out to west." + "Sauna" + ) + ( + "You are at the end of a north/south hallway. You can go back to the south, + or off to a room to the east." + "End of N/S Hallway" + ) + ( + "You are in an old weight room. All of the equipment is either destroyed + or completely broken. There is a door out to the west, and there is a ladder + leading down a hole in the floor." + "Weight room" ;16 + ) + ( + "You are in a maze of twisty little passages, all alike. + There is a button on the ground here." + "Maze button room" + ) + ( + "You are in a maze of little twisty passages, all alike." + "Maze" + ) + ( + "You are in a maze of thirsty little passages, all alike." + "Maze" ;19 + ) + ( + "You are in a maze of twenty little passages, all alike." + "Maze" + ) + ( + "You are in a daze of twisty little passages, all alike." + "Maze" ;21 + ) + ( + "You are in a maze of twisty little cabbages, all alike." + "Maze" ;22 + ) + ( + "You are in a reception area for a health and fitness center. The place + appears to have been recently ransacked, and nothing is left. There is + a door out to the south, and a crawlspace to the southeast." + "Reception area" + ) + ( + "You are outside a large building to the north which used to be a health + and fitness center. A road leads to the south." + "Health Club front" + ) + ( + "You are at the north side of a lake. On the other side you can see + a road which leads to a cave. The water appears very deep." + "Lakefront North" + ) + ( + "You are at the south side of a lake. A road goes to the south." + "Lakefront South" + ) + ( + "You are in a well-hidden area off to the side of a road. Back to the + northeast through the brush you can see the bear hangout." + "Hidden area" + ) + ( + "The entrance to a cave is to the south. To the north, a road leads + towards a deep lake. On the ground nearby there is a chute, with a sign + that says 'put treasures here for points'." + "Cave Entrance" ;28 + ) + ( + "You are in a misty, humid room carved into a mountain. + To the north is the remains of a rockslide. To the east, a small + passage leads away into the darkness." ;29 + "Misty Room" + ) + ( + "You are in an east/west passageway. The walls here are made of + multicolored rock and are quite beautiful." + "Cave E/W passage" ;30 + ) + ( + "You are at the junction of two passages. One goes north/south, and + the other goes west." + "N/S/W Junction" ;31 + ) + ( + "You are at the north end of a north/south passageway. There are stairs + leading down from here. There is also a door leading west." + "North end of cave passage" ;32 + ) + ( + "You are at the south end of a north/south passageway. There is a hole + in the floor here, into which you could probably fit." + "South end of cave passage" ;33 + ) + ( + "You are in what appears to be a worker's bedroom. There is a queen- + sized bed in the middle of the room, and a painting hanging on the + wall. A door leads to another room to the south, and stairways + lead up and down." + "Bedroom" ;34 + ) + ( + "You are in a bathroom built for workers in the cave. There is a + urinal hanging on the wall, and some exposed pipes on the opposite + wall where a sink used to be. To the north is a bedroom." + "Bathroom" ;35 + ) + ( + "This is a marker for the urinal. User will not see this, but it + is a room that can contain objects." + "Urinal" ;36 + ) + ( + "You are at the northeast end of a northeast/southwest passageway. + Stairs lead up out of sight." + "Ne end of ne/sw cave passage" ;37 + ) + ( + "You are at the junction of northeast/southwest and east/west passages." + "Ne/sw-e/w junction" ;38 + ) + ( + "You are at the southwest end of a northeast/southwest passageway." + "Sw end of ne/sw cave passage" ;39 + ) + ( + "You are at the east end of an e/w passage. There are stairs leading up + to a room above." + "East end of e/w cave passage" ;40 + ) + ( + "You are at the west end of an e/w passage. There is a hole on the ground + which leads down out of sight." + "West end of e/w cave passage" ;41 + ) + ( + "You are in a room which is bare, except for a horseshoe shaped boulder + in the center. Stairs lead down from here." ;42 + "Horseshoe boulder room" + ) + ( + "You are in a room which is completely empty. Doors lead out to the north + and east." + "Empty room" ;43 + ) + ( + "You are in an empty room. Interestingly enough, the stones in this + room are painted blue. Doors lead out to the east and south." ;44 + "Blue room" + ) + ( + "You are in an empty room. Interestingly enough, the stones in this + room are painted yellow. Doors lead out to the south and west." ;45 + "Yellow room" + ) + ( + "You are in an empty room. Interestingly enough, the stones in this room + are painted red. Doors lead out to the west and north." + "Red room" ;46 + ) + ( + "You are in the middle of a long north/south hallway." ;47 + "Long n/s hallway" + ) + ( + "You are 3/4 of the way towards the north end of a long north/south hallway." + "3/4 north" ;48 + ) + ( + "You are at the north end of a long north/south hallway. There are stairs + leading upwards." + "North end of long hallway" ;49 + ) + ( + "You are 3/4 of the way towards the south end of a long north/south hallway." + "3/4 south" ;50 + ) + ( + "You are at the south end of a long north/south hallway. There is a hole + to the south." + "South end of long hallway" ;51 + ) + ( + "You are at a landing in a stairwell which continues up and down." + "Stair landing" ;52 + ) + ( + "You are at the continuation of an up/down staircase." + "Up/down staircase" ;53 + ) + ( + "You are at the top of a staircase leading down. A crawlway leads off + to the northeast." + "Top of staircase." ;54 + ) + ( + "You are in a crawlway that leads northeast or southwest." + "Ne crawlway" ;55 + ) + ( + "You are in a small crawlspace. There is a hole in the ground here, and + a small passage back to the southwest." + "Small crawlspace" ;56 + ) + ( + "You are in the Gamma Computing Center. An IBM 3090/600s is whirring + away in here. There is an ethernet cable coming out of one of the units, + and going through the ceiling. There is no console here on which you + could type." + "Gamma computing center" ;57 + ) + ( + "You are near the remains of a post office. There is a mail drop on the + face of the building, but you cannot see where it leads. A path leads + back to the east, and a road leads to the north." + "Post office" ;58 + ) + ( + "You are at the intersection of Main Street and Maple Ave. Main street + runs north and south, and Maple Ave runs east off into the distance. + If you look north and east you can see many intersections, but all of + the buildings that used to stand here are gone. Nothing remains except + street signs. + There is a road to the northwest leading to a gate that guards a building." + "Main-Maple intersection" ;59 + ) + ( + "You are at the intersection of Main Street and the west end of Oaktree Ave." + "Main-Oaktree intersection" ;60 + ) + ( + "You are at the intersection of Main Street and the west end of Vermont Ave." + "Main-Vermont intersection" ;61 + ) + ( + "You are at the north end of Main Street at the west end of Sycamore Ave." ;62 + "Main-Sycamore intersection" + ) + ( + "You are at the south end of First Street at Maple Ave." ;63 + "First-Maple intersection" + ) + ( + "You are at the intersection of First Street and Oaktree Ave." ;64 + "First-Oaktree intersection" + ) + ( + "You are at the intersection of First Street and Vermont Ave." ;65 + "First-Vermont intersection" + ) + ( + "You are at the north end of First Street at Sycamore Ave." ;66 + "First-Sycamore intersection" + ) + ( + "You are at the south end of Second Street at Maple Ave." ;67 + "Second-Maple intersection" + ) + ( + "You are at the intersection of Second Street and Oaktree Ave." ;68 + "Second-Oaktree intersection" + ) + ( + "You are at the intersection of Second Street and Vermont Ave." ;69 + "Second-Vermont intersection" + ) + ( + "You are at the north end of Second Street at Sycamore Ave." ;70 + "Second-Sycamore intersection" + ) + ( + "You are at the south end of Third Street at Maple Ave." ;71 + "Third-Maple intersection" + ) + ( + "You are at the intersection of Third Street and Oaktree Ave." ;72 + "Third-Oaktree intersection" + ) + ( + "You are at the intersection of Third Street and Vermont Ave." ;73 + "Third-Vermont intersection" + ) + ( + "You are at the north end of Third Street at Sycamore Ave." ;74 + "Third-Sycamore intersection" + ) + ( + "You are at the south end of Fourth Street at Maple Ave." ;75 + "Fourth-Maple intersection" + ) + ( + "You are at the intersection of Fourth Street and Oaktree Ave." ;76 + "Fourth-Oaktree intersection" + ) + ( + "You are at the intersection of Fourth Street and Vermont Ave." ;77 + "Fourth-Vermont intersection" + ) + ( + "You are at the north end of Fourth Street at Sycamore Ave." ;78 + "Fourth-Sycamore intersection" + ) + ( + "You are at the south end of Fifth Street at the east end of Maple Ave." ;79 + "Fifth-Maple intersection" + ) + ( + "You are at the intersection of Fifth Street and the east end of Oaktree Ave. + There is a cliff off to the east." + "Fifth-Oaktree intersection" ;80 + ) + ( + "You are at the intersection of Fifth Street and the east end of Vermont Ave." + "Fifth-Vermont intersection" ;81 + ) + ( + "You are at the north end of Fifth Street and the east end of Sycamore Ave." + "Fifth-Sycamore intersection" ;82 + ) + ( + "You are in front of the Museum of Natural History. A door leads into + the building to the north, and a road leads to the southeast." + "Museum entrance" ;83 + ) + ( + "You are in the main lobby for the Museum of Natural History. In the center + of the room is the huge skeleton of a dinosaur. Doors lead out to the + south and east." + "Museum lobby" ;84 + ) + ( + "You are in the geological display. All of the objects that used to + be on display are missing. There are rooms to the east, west, and + north." + "Geological display" ;85 + ) + ( + "You are in the marine life area. The room is filled with fish tanks, + which are filled with dead fish that have apparently died due to + starvation. Doors lead out to the south and east." + "Marine life area" ;86 + ) + ( + "You are in some sort of maintenance room for the museum. There is a + switch on the wall labeled 'BL'. There are doors to the west and north." + "Maintenance room" ;87 + ) + ( + "You are in a classroom where school children were taught about natural + history. On the blackboard is written, 'No children allowed downstairs.' + There is a door to the east with an 'exit' sign on it. There is another + door to the west." + "Classroom" ;88 + ) + ( + "You are at the Vermont St. subway station. A train is sitting here waiting." + "Vermont station" ;89 + ) + ( + "You are at the Museum subway stop. A passage leads off to the north." + "Museum station" ;90 + ) + ( + "You are in a north/south tunnel." + "N/S tunnel" ;91 + ) + ( + "You are at the north end of a north/south tunnel. Stairs lead up and + down from here. There is a garbage disposal here." + "North end of n/s tunnel" ;92 + ) + ( + "You are at the top of some stairs near the subway station. There is + a door to the west." + "Top of subway stairs" ;93 + ) + ( + "You are at the bottom of some stairs near the subway station. There is + a room to the northeast." + "Bottom of subway stairs" ;94 + ) + ( + "You are in another computer room. There is a computer in here larger + than you have ever seen. It has no manufacturers name on it, but it + does have a sign that says: This machine's name is 'endgame'. The + exit is to the southwest. There is no console here on which you could + type." + "Endgame computer room" ;95 + ) + ( + "You are in a north/south hallway." + "Endgame n/s hallway" ;96 + ) + ( + "You have reached a question room. You must answer a question correctly in + order to get by. Use the 'answer' command to answer the question." + "Question room 1" ;97 + ) + ( + "You are in a north/south hallway." + "Endgame n/s hallway" ;98 + ) + ( + "You are in a second question room." + "Question room 2" ;99 + ) + ( + "You are in a north/south hallway." + "Endgame n/s hallway" ;100 + ) + ( + "You are in a third question room." + "Question room 3" ;101 + ) + ( + "You are in the endgame treasure room. A door leads out to the north, and + a hallway leads to the south." + "Endgame treasure room" ;102 + ) + ( + "You are in the winner's room. A door leads back to the south." + "Winner's room" ;103 + ) + ( + "You have reached a dead end. There is a PC on the floor here. Above + it is a sign that reads: + Type the 'reset' command to type on the PC. + A hole leads north." + "PC area" ;104 + ) + )) + + (setq dun-light-rooms '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 24 25 26 27 28 58 59 + 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 + 77 78 79 80 81 82 83)) + + (setq dun-verblist '((die . dun-die) (ne . dun-ne) (north . dun-n) + (south . dun-s) (east . dun-e) (west . dun-w) + (u . dun-up) (d . dun-down) (i . dun-inven) + (inventory . dun-inven) (look . dun-examine) (n . dun-n) + (s . dun-s) (e . dun-e) (w . dun-w) (se . dun-se) + (nw . dun-nw) (sw . dun-sw) (up . dun-up) + (down . dun-down) (in . dun-in) (out . dun-out) + (go . dun-go) (drop . dun-drop) (southeast . dun-se) + (southwest . dun-sw) (northeast . dun-ne) + (northwest . dun-nw) (save . dun-save-game) + (restore . dun-restore) (long . dun-long) (dig . dun-dig) + (shake . dun-shake) (wave . dun-shake) + (examine . dun-examine) (describe . dun-examine) + (climb . dun-climb) (eat . dun-eat) (put . dun-put) + (type . dun-type) (insert . dun-put) + (score . dun-score) (help . dun-help) (quit . dun-quit) + (read . dun-examine) (verbose . dun-long) + (urinate . dun-piss) (piss . dun-piss) + (flush . dun-flush) (sleep . dun-sleep) (lie . dun-sleep) + (x . dun-examine) (break . dun-break) (drive . dun-drive) + (board . dun-in) (enter . dun-in) (turn . dun-turn) + (press . dun-press) (push . dun-press) (swim . dun-swim) + (on . dun-in) (off . dun-out) (chop . dun-break) + (switch . dun-press) (cut . dun-break) (exit . dun-out) + (leave . dun-out) (reset . dun-power) (flick . dun-press) + (superb . dun-superb) (answer . dun-answer) + (throw . dun-drop) (l . dun-examine) (take . dun-take) + (get . dun-take) (feed . dun-feed))) + + (setq dun-inbus nil) + (setq dun-nomail nil) + (setq dun-ignore '(the to at)) + (setq dun-mode 'moby) + (setq dun-sauna-level 0) + + (defconst north 0) + (defconst south 1) + (defconst east 2) + (defconst west 3) + (defconst northeast 4) + (defconst southeast 5) + (defconst northwest 6) + (defconst southwest 7) + (defconst up 8) + (defconst down 9) + (defconst in 10) + (defconst out 11) + + (setq dungeon-map '( + ; no so ea we ne se nw sw up do in ot + ( 96 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;0 + ( -1 -1 2 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;1 + ( -1 -1 3 1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;2 + ( -1 -1 -1 2 4 6 -1 -1 -1 -1 -1 -1 ) ;3 + ( -1 -1 -1 -1 5 -1 -1 3 -1 -1 -1 -1 ) ;4 + ( -1 -1 -1 -1 255 -1 -1 4 -1 -1 255 -1 ) ;5 + ( -1 -1 -1 -1 -1 7 3 -1 -1 -1 -1 -1 ) ;6 + ( -1 -1 -1 -1 -1 255 6 27 -1 -1 -1 -1 ) ;7 + ( 255 5 9 10 -1 -1 -1 5 -1 -1 -1 5 ) ;8 + ( -1 -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 ) ;9 + ( -1 -1 8 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;10 + ( -1 8 -1 58 -1 -1 -1 -1 -1 -1 -1 -1 ) ;11 + ( -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;12 + ( 15 -1 14 12 -1 -1 -1 -1 -1 -1 -1 -1 ) ;13 + ( -1 -1 -1 13 -1 -1 -1 -1 -1 -1 -1 -1 ) ;14 + ( -1 13 16 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;15 + ( -1 -1 -1 15 -1 -1 -1 -1 -1 17 16 -1 ) ;16 + ( -1 -1 17 17 17 17 255 17 255 17 -1 -1 ) ;17 + ( 18 18 18 18 18 -1 18 18 19 18 -1 -1 ) ;18 + ( -1 18 18 19 19 20 19 19 -1 18 -1 -1 ) ;19 + ( -1 -1 -1 18 -1 -1 -1 -1 -1 21 -1 -1 ) ;20 + ( -1 -1 -1 -1 -1 20 22 -1 -1 -1 -1 -1 ) ;21 + ( 18 18 18 18 16 18 23 18 18 18 18 18 ) ;22 + ( -1 255 -1 -1 -1 19 -1 -1 -1 -1 -1 -1 ) ;23 + ( 23 25 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;24 + ( 24 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;25 + (255 28 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;26 + ( -1 -1 -1 -1 7 -1 -1 -1 -1 -1 -1 -1 ) ;27 + ( 26 255 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;28 + ( -1 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;29 + ( -1 -1 31 29 -1 -1 -1 -1 -1 -1 -1 -1 ) ;30 + ( 32 33 -1 30 -1 -1 -1 -1 -1 -1 -1 -1 ) ;31 + ( -1 31 -1 255 -1 -1 -1 -1 -1 34 -1 -1 ) ;32 + ( 31 -1 -1 -1 -1 -1 -1 -1 -1 35 -1 -1 ) ;33 + ( -1 35 -1 -1 -1 -1 -1 -1 32 37 -1 -1 ) ;34 + ( 34 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;35 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;36 + ( -1 -1 -1 -1 -1 -1 -1 38 34 -1 -1 -1 ) ;37 + ( -1 -1 40 41 37 -1 -1 39 -1 -1 -1 -1 ) ;38 + ( -1 -1 -1 -1 38 -1 -1 -1 -1 -1 -1 -1 ) ;39 + ( -1 -1 -1 38 -1 -1 -1 -1 42 -1 -1 -1 ) ;40 + ( -1 -1 38 -1 -1 -1 -1 -1 -1 43 -1 -1 ) ;41 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 40 -1 -1 ) ;42 + ( 44 -1 46 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;43 + ( -1 43 45 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;44 + ( -1 46 -1 44 -1 -1 -1 -1 -1 -1 -1 -1 ) ;45 + ( 45 -1 -1 43 -1 -1 -1 -1 -1 255 -1 -1 ) ;46 + ( 48 50 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;47 + ( 49 47 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;48 + ( -1 48 -1 -1 -1 -1 -1 -1 52 -1 -1 -1 ) ;49 + ( 47 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;50 + ( 50 104 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;51 + ( -1 -1 -1 -1 -1 -1 -1 -1 53 49 -1 -1 ) ;52 + ( -1 -1 -1 -1 -1 -1 -1 -1 54 52 -1 -1 ) ;53 + ( -1 -1 -1 -1 55 -1 -1 -1 -1 53 -1 -1 ) ;54 + ( -1 -1 -1 -1 56 -1 -1 54 -1 -1 -1 54 ) ;55 + ( -1 -1 -1 -1 -1 -1 -1 55 -1 31 -1 -1 ) ;56 + ( -1 -1 32 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;57 + ( 59 -1 11 -1 -1 -1 -1 -1 -1 -1 255 255) ;58 + ( 60 58 63 -1 -1 -1 255 -1 -1 -1 255 255) ;59 + ( 61 59 64 -1 -1 -1 -1 -1 -1 -1 255 255) ;60 + ( 62 60 65 -1 -1 -1 -1 -1 -1 -1 255 255) ;61 + ( -1 61 66 -1 -1 -1 -1 -1 -1 -1 255 255) ;62 + ( 64 -1 67 59 -1 -1 -1 -1 -1 -1 255 255) ;63 + ( 65 63 68 60 -1 -1 -1 -1 -1 -1 255 255) ;64 + ( 66 64 69 61 -1 -1 -1 -1 -1 -1 255 255) ;65 + ( -1 65 70 62 -1 -1 -1 -1 -1 -1 255 255) ;66 + ( 68 -1 71 63 -1 -1 -1 -1 -1 -1 255 255) ;67 + ( 69 67 72 64 -1 -1 -1 -1 -1 -1 255 255) ;68 + ( 70 68 73 65 -1 -1 -1 -1 -1 -1 255 255) ;69 + ( -1 69 74 66 -1 -1 -1 -1 -1 -1 255 255) ;70 + ( 72 -1 75 67 -1 -1 -1 -1 -1 -1 255 255) ;71 + ( 73 71 76 68 -1 -1 -1 -1 -1 -1 255 255) ;72 + ( 74 72 77 69 -1 -1 -1 -1 -1 -1 255 255) ;73 + ( -1 73 78 70 -1 -1 -1 -1 -1 -1 255 255) ;74 + ( 76 -1 79 71 -1 -1 -1 -1 -1 -1 255 255) ;75 + ( 77 75 80 72 -1 -1 -1 -1 -1 -1 255 255) ;76 + ( 78 76 81 73 -1 -1 -1 -1 -1 -1 255 255) ;77 + ( -1 77 82 74 -1 -1 -1 -1 -1 -1 255 255) ;78 + ( 80 -1 -1 75 -1 -1 -1 -1 -1 -1 255 255) ;79 + ( 81 79 255 76 -1 -1 -1 -1 -1 -1 255 255) ;80 + ( 82 80 -1 77 -1 -1 -1 -1 -1 -1 255 255) ;81 + ( -1 81 -1 78 -1 -1 -1 -1 -1 -1 255 255) ;82 + ( 84 -1 -1 -1 -1 59 -1 -1 -1 -1 255 255) ;83 + ( -1 83 85 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;84 + ( 86 -1 87 84 -1 -1 -1 -1 -1 -1 -1 -1 ) ;85 + ( -1 85 88 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;86 + ( 88 -1 -1 85 -1 -1 -1 -1 -1 -1 -1 -1 ) ;87 + ( -1 87 255 86 -1 -1 -1 -1 -1 -1 -1 -1 ) ;88 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 255 -1 ) ;89 + ( 91 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;90 + ( 92 90 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;91 + ( -1 91 -1 -1 -1 -1 -1 -1 93 94 -1 -1 ) ;92 + ( -1 -1 -1 88 -1 -1 -1 -1 -1 92 -1 -1 ) ;93 + ( -1 -1 -1 -1 95 -1 -1 -1 92 -1 -1 -1 ) ;94 + ( -1 -1 -1 -1 -1 -1 -1 94 -1 -1 -1 -1 ) ;95 + ( 97 0 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;96 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;97 + ( 99 97 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;98 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;99 + ( 101 99 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;100 + ( -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;101 + ( 103 101 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;102 + ( -1 102 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;103 + ( 51 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 ) ;104 + ) + ; no so ea we ne se nw sw up do in ot + ) + + + ;;; How the user references *all* objects, permanent and regular. + (setq dun-objnames '( + (shovel . 0) + (lamp . 1) + (cpu . 2) (board . 2) (card . 2) + (food . 3) + (key . 4) + (paper . 5) + (rms . 6) (statue . 6) (statuette . 6) (stallman . 6) + (diamond . 7) + (weight . 8) + (life . 9) (preserver . 9) + (bracelet . 10) (emerald . 10) + (gold . 11) + (platinum . 12) + (towel . 13) (beach . 13) + (axe . 14) + (silver . 15) + (license . 16) + (coins . 17) + (egg . 18) + (jar . 19) + (bone . 20) + (acid . 21) (nitric . 21) + (glycerine . 22) + (ruby . 23) + (amethyst . 24) + (mona . 25) + (bill . 26) + (floppy . 27) (disk . 27) + + (boulder . -1) + (tree . -2) (trees . -2) + (bear . -3) + (bin . -4) (bins . -4) + (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5) + (protoplasm . -6) + (dial . -7) + (button . -8) + (chute . -9) + (painting . -10) + (bed . -11) + (urinal . -12) + (URINE . -13) + (pipes . -14) (pipe . -14) + (box . -15) (slit . -15) + (cable . -16) (ethernet . -16) + (mail . -17) (drop . -17) + (bus . -18) + (gate . -19) + (cliff . -20) + (skeleton . -21) (dinosaur . -21) + (fish . -22) + (tanks . -23) + (switch . -24) + (blackboard . -25) + (disposal . -26) (garbage . -26) + (ladder . -27) + (subway . -28) (train . -28) + (pc . -29) (drive . -29) + )) + + (dolist (x dun-objnames) + (let (name) + (setq name (concat "obj-" (prin1-to-string (car x)))) + (eval (list 'defconst (intern name) (cdr x))))) + + (defconst obj-special 255) + + ;;; The initial setup of what objects are in each room. + ;;; Regular objects have whole numbers lower than 255. + ;;; Objects that cannot be taken but might move and are + ;;; described during room description are negative. + ;;; Stuff that is described and might change are 255, and are + ;;; handled specially by 'dun-describe-room. + + (setq dun-room-objects (list nil + + (list obj-shovel) ;; treasure-room + (list obj-boulder) ;; dead-end + nil nil nil + (list obj-food) ;; se-nw-road + (list obj-bear) ;; bear-hangout + nil nil + (list obj-special) ;; computer-room + (list obj-lamp obj-license obj-silver);; meadow + nil nil + (list obj-special) ;; sauna + nil + (list obj-weight obj-life) ;; weight-room + nil nil + (list obj-rms obj-floppy) ;; thirsty-maze + nil nil nil nil nil nil nil + (list obj-emerald) ;; hidden-area + nil + (list obj-gold) ;; misty-room + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + (list obj-towel obj-special) ;; red-room + nil nil nil nil nil + (list obj-box) ;; stair-landing + nil nil nil + (list obj-axe) ;; smal-crawlspace + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + nil nil nil nil nil + (list obj-special) ;; fourth-vermont-intersection + nil nil + (list obj-coins) ;; fifth-oaktree-intersection + nil + (list obj-bus) ;; fifth-sycamore-intersection + nil + (list obj-bone) ;; museum-lobby + nil + (list obj-jar obj-special obj-ruby) ;; marine-life-area + (list obj-nitric) ;; maintenance-room + (list obj-glycerine) ;; classroom + nil nil nil nil nil + (list obj-amethyst) ;; bottom-of-subway-stairs + nil nil + (list obj-special) ;; question-room-1 + nil + (list obj-special) ;; question-room-2 + nil + (list obj-special) ;; question-room-three + nil + (list obj-mona) ;; winner's-room + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil + nil)) + + ;;; These are objects in a room that are only described in the + ;;; room description. They are permanent. + + (setq dun-room-silents (list nil + (list obj-tree) ;; dead-end + (list obj-tree) ;; e-w-dirt-road + nil nil nil nil nil nil + (list obj-bin) ;; mailroom + (list obj-computer) ;; computer-room + nil nil nil + (list obj-dial) ;; sauna + nil + (list obj-ladder) ;; weight-room + (list obj-button obj-ladder) ;; maze-button-room + nil nil nil + nil nil nil nil nil nil nil + (list obj-chute) ;; cave-entrance + nil nil nil nil nil + (list obj-painting obj-bed) ;; bedroom + (list obj-urinal obj-pipes) ;; bathroom + nil nil nil nil nil nil + (list obj-boulder) ;; horseshoe-boulder-room + nil nil nil nil nil nil nil nil nil nil nil nil nil nil + (list obj-computer obj-cable) ;; gamma-computing-center + (list obj-mail) ;; post-office + (list obj-gate) ;; main-maple-intersection + nil nil nil nil nil nil nil nil nil nil nil nil nil + nil nil nil nil nil nil nil + (list obj-cliff) ;; fifth-oaktree-intersection + nil nil nil + (list obj-dinosaur) ;; museum-lobby + nil + (list obj-fish obj-tanks) ;; marine-life-area + (list obj-switch) ;; maintenance-room + (list obj-blackboard) ;; classroom + (list obj-train) ;; vermont-station + nil nil + (list obj-disposal) ;; north-end-of-n-s-tunnel + nil nil + (list obj-computer) ;; endgame-computer-room + nil nil nil nil nil nil nil nil + (list obj-pc) ;; pc-area + nil nil nil nil nil nil + )) + (setq dun-inventory '(1)) + + ;;; Descriptions of objects, as they appear in the room description, and + ;;; the inventory. + + (setq dun-objects '( + ("There is a shovel here." "A shovel") ;0 + ("There is a lamp nearby." "A lamp") ;1 + ("There is a CPU card here." "A computer board") ;2 + ("There is some food here." "Some food") ;3 + ("There is a shiny brass key here." "A brass key") ;4 + ("There is a slip of paper here." "A slip of paper") ;5 + ("There is a wax statuette of Richard Stallman here." ;6 + "An RMS statuette") + ("There is a shimmering diamond here." "A diamond") ;7 + ("There is a 10 pound weight here." "A weight") ;8 + ("There is a life preserver here." "A life preserver");9 + ("There is an emerald bracelet here." "A bracelet") ;10 + ("There is a gold bar here." "A gold bar") ;11 + ("There is a platinum bar here." "A platinum bar") ;12 + ("There is a beach towel on the ground here." "A beach towel") + ("There is an axe here." "An axe") ;14 + ("There is a silver bar here." "A silver bar") ;15 + ("There is a bus driver's license here." "A license") ;16 + ("There are some valuable coins here." "Some valuable coins") + ("There is a jewel-encrusted egg here." "A valuable egg") ;18 + ("There is a glass jar here." "A glass jar") ;19 + ("There is a dinosaur bone here." "A bone") ;20 + ("There is a packet of nitric acid here." "Some nitric acid") + ("There is a packet of glycerine here." "Some glycerine") ;22 + ("There is a valuable ruby here." "A ruby") ;23 + ("There is a valuable amethyst here." "An amethyst") ;24 + ("The Mona Lisa is here." "The Mona Lisa") ;25 + ("There is a 100 dollar bill here." "A $100 bill") ;26 + ("There is a floppy disk here." "A floppy disk") ;27 + ) + ) + + ;;; Weight of objects + + (setq dun-object-lbs + '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0)) + (setq dun-object-pts + '(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0)) + + + ;;; Unix representation of objects. + (setq dun-objfiles '( + "shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o" + "rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o" + "gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o" + "coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o" + "ruby.o" "amethyst.o" + )) + + ;;; These are the descriptions for the negative numbered objects from + ;;; dun-room-objects + + (setq dun-perm-objects '( + nil + ("There is a large boulder here.") + nil + ("There is a ferocious bear here!") + nil + nil + ("There is a worthless pile of protoplasm here.") + nil + nil + nil + nil + nil + nil + ("There is a strange smell in this room.") + nil + ( + "There is a box with a slit in it, bolted to the wall here." + ) + nil + nil + ("There is a bus here.") + nil + nil + nil + )) + + + ;;; These are the descriptions the user gets when regular objects are + ;;; examined. + + (setq dun-physobj-desc '( + "It is a normal shovel with a price tag attached that says $19.99." + "The lamp is hand-crafted by Geppetto." + "The CPU board has a VAX chip on it. It seems to have + 2 Megabytes of RAM onboard." + "It looks like some kind of meat. Smells pretty bad." + nil + "The paper says: Don't forget to type 'help' for help. Also, remember + this word: 'worms'" + "The statuette is of the likeness of Richard Stallman, the author of the + famous EMACS editor. You notice that he is not wearing any shoes." + nil + "You observe that the weight is heavy." + "It says S. S. Minnow." + nil + nil + nil + "It has a picture of snoopy on it." + nil + nil + "It has your picture on it!" + "They are old coins from the 19th century." + "It is a valuable Fabrege egg." + "It is a a plain glass jar." + nil + nil + nil + nil + nil + ) + ) + + ;;; These are the descriptions the user gets when non-regular objects + ;;; are examined. + + (setq dun-permobj-desc '( + nil + "It is just a boulder. It cannot be moved." + "They are palm trees with a bountiful supply of coconuts in them." + "It looks like a grizzly to me." + "All of the bins are empty. Looking closely you can see that there + are names written at the bottom of each bin, but most of them are + faded away so that you cannot read them. You can only make out three + names: + Jeffrey Collier + Robert Toukmond + Thomas Stock + " + nil + "It is just a garbled mess." + "The dial points to a temperature scale which has long since faded away." + nil + nil + "It is a velvet painting of Elvis Presly. It seems to be nailed to the + wall, and you cannot move it." + "It is a queen sized bed, with a very firm mattress." + "The urinal is very clean compared with everything else in the cave. There + isn't even any rust. Upon close examination you realize that the drain at the + bottom is missing, and there is just a large hole leading down the + pipes into nowhere. The hole is too small for a person to fit in. The + flush handle is so clean that you can see your reflection in it." + nil + nil + "The box has a slit in the top of it, and on it, in sloppy handwriting, is + written: 'For key upgrade, put key in here.'" + nil + "It says 'express mail' on it." + "It is a 35 passenger bus with the company name 'mobytours' on it." + "It is a large metal gate that is too big to climb over." + "It is a HIGH cliff." + "Unfortunately you do not know enough about dinosaurs to tell very much about + it. It is very big, though." + "The fish look like they were once quite beautiful." + nil + nil + nil + nil + "It is a normal ladder that is permanently attached to the hole." + "It is a passenger train that is ready to go." + "It is a personal computer that has only one floppy disk drive." + ) + ) + + (setq dun-diggables + (list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil + nil nil nil nil nil nil nil nil nil nil ;11-20 + nil nil nil nil nil nil nil nil nil nil ;21-30 + nil nil nil nil nil nil nil nil nil nil ;31-40 + nil (list obj-platinum) nil nil nil nil nil nil nil nil)) + + (setq scroll-step 2) + + (setq dun-room-shorts nil) + (dolist (x dun-rooms) + (setq dun-room-shorts + (append dun-room-shorts (list (downcase + (dun-space-to-hyphen + (cadr x))))))) + + (setq dun-endgame-questions '( + ( + "What is your password on the machine called 'pokey'?" "robert") + ( + "What password did you use during anonymous ftp to gamma?" "foo") + ( + "Excluding the endgame, how many places are there where you can put + treasures for points?" "4" "four") + ( + "What is your login name on the 'endgame' machine?" "toukmond" + ) + ( + "What is the nearest whole dollar to the price of the shovel?" "20" "twenty") + ( + "What is the name of the bus company serving the town?" "mobytours") + ( + "Give either of the two last names in the mailroom, other than your own." + "collier" "stock") + ( + "What cartoon character is on the towel?" "snoopy") + ( + "What is the last name of the author of EMACS?" "stallman") + ( + "How many megabytes of memory is on the CPU board for the Vax?" "2") + ( + "Which street in town is named after a U.S. state?" "vermont") + ( + "How many pounds did the weight weigh?" "ten" "10") + ( + "Name the STREET which runs right over the subway stop." "fourth" "4" "4th") + ( + "How many corners are there in town (excluding the one with the Post Office)?" + "24" "twentyfour" "twenty-four") + ( + "What type of bear was hiding your key?" "grizzly") + ( + "Name either of the two objects you found by digging." "cpu" "card" "vax" + "board" "platinum") + ( + "What network protocol is used between pokey and gamma?" "tcp/ip" "ip" "tcp") + )) + + (let (a) + (setq a 0) + (dolist (x dun-room-shorts) + (eval (list 'defconst (intern x) a)) + (setq a (+ a 1)))) + + + + ;;;; + ;;;; This section defines the UNIX emulation functions for dunnet. + ;;;; + + (defun dun-unix-parse (args) + (interactive "*p") + (beginning-of-line) + (let (beg esign) + (setq beg (+ (point) 2)) + (end-of-line) + (if (and (not (= beg (point))) + (string= "$" (buffer-substring (- beg 2) (- beg 1)))) + (progn + (setq line (downcase (buffer-substring beg (point)))) + (princ line) + (if (eq (dun-parse2 nil dun-unix-verbs line) -1) + (progn + (if (setq esign (string-match "=" line)) + (dun-doassign line esign) + (dun-mprinc (car line-list)) + (dun-mprincl ": not found."))))) + (goto-char (point-max)) + (dun-mprinc "\n")) + (if (eq dungeon-mode 'unix) + (progn + (dun-fix-screen) + (dun-mprinc "$ "))))) + + (defun dun-doassign (line esign) + (if (not dun-wizard) + (let (passwd) + (dun-mprinc "Enter wizard password: ") + (setq passwd (dun-read-line)) + (if (not dun-batch-mode) + (dun-mprinc "\n")) + (if (string= passwd "moby") + (progn + (setq dun-wizard t) + (dun-doassign line esign)) + (dun-mprincl "Incorrect."))) + + (let (varname epoint afterq i value) + (setq varname (substring line 0 esign)) + (if (not (setq epoint (string-match ")" line))) + (if (string= (substring line (1+ esign) (+ esign 2)) + "\"") + (progn + (setq afterq (substring line (+ esign 2))) + (setq epoint (+ + (string-match "\"" afterq) + (+ esign 3)))) + + (if (not (setq epoint (string-match " " line))) + (setq epoint (length line)))) + (setq epoint (1+ epoint)) + (while (and + (not (= epoint (length line))) + (setq i (string-match ")" (substring line epoint)))) + (setq epoint (+ epoint i 1)))) + (setq value (substring line (1+ esign) epoint)) + (dun-eval varname value)))) + + (defun dun-eval (varname value) + (let (eval-error) + (switch-to-buffer (get-buffer-create "*dungeon-eval*")) + (erase-buffer) + (insert "(setq ") + (insert varname) + (insert " ") + (insert value) + (insert ")") + (setq eval-error nil) + (condition-case nil + (eval-current-buffer) + (error (setq eval-error t))) + (kill-buffer (current-buffer)) + (switch-to-buffer "*dungeon*") + (if eval-error + (dun-mprincl "Invalid syntax.")))) + + + (defun dun-unix-interface () + (dun-login) + (if dun-logged-in + (progn + (setq dungeon-mode 'unix) + (define-key dungeon-mode-map "\r" 'dun-unix-parse) + (dun-mprinc "$ ")))) + + (defun dun-login () + (let (tries username password) + (setq tries 4) + (while (and (not dun-logged-in) (> (setq tries (- tries 1)) 0)) + (dun-mprinc "\n\nUNIX System V, Release 2.2 (pokey)\n\nlogin: ") + (setq username (dun-read-line)) + (if (not dun-batch-mode) + (dun-mprinc "\n")) + (dun-mprinc "password: ") + (setq password (dun-read-line)) + (if (not dun-batch-mode) + (dun-mprinc "\n")) + (if (or (not (string= username "toukmond")) + (not (string= password "robert"))) + (dun-mprincl "login incorrect") + (setq dun-logged-in t) + (dun-mprincl " + Welcome to Unix\n + Please clean up your directories. The filesystem is getting full. + Our tcp/ip link to gamma is a little flakey, but seems to work. + The current version of ftp can only send files from the current + directory, and deletes them after they are sent! Be careful. + + Note: Restricted bourne shell in use.\n"))) + (setq dungeon-mode 'dungeon))) + + (defun dun-ls (args) + (if (car args) + (let (ocdpath ocdroom) + (setq ocdpath dun-cdpath) + (setq ocdroom dun-cdroom) + (if (not (eq (dun-cd args) -2)) + (dun-ls nil)) + (setq dun-cdpath ocdpath) + (setq dun-cdroom ocdroom)) + (if (= dun-cdroom -10) + (dun-ls-inven)) + (if (= dun-cdroom -2) + (dun-ls-rooms)) + (if (= dun-cdroom -3) + (dun-ls-root)) + (if (= dun-cdroom -4) + (dun-ls-usr)) + (if (> dun-cdroom 0) + (dun-ls-room)))) + + (defun dun-ls-root () + (dun-mprincl "total 4 + drwxr-xr-x 3 root staff 512 Jan 1 1970 . + drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. + drwxr-xr-x 3 root staff 2048 Jan 1 1970 usr + drwxr-xr-x 3 root staff 2048 Jan 1 1970 rooms")) + + (defun dun-ls-usr () + (dun-mprincl "total 4 + drwxr-xr-x 3 root staff 512 Jan 1 1970 . + drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. + drwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 toukmond")) + + (defun dun-ls-rooms () + (dun-mprincl "total 16 + drwxr-xr-x 3 root staff 512 Jan 1 1970 . + drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") + (dolist (x dun-visited) + (dun-mprinc + "drwxr-xr-x 3 root staff 512 Jan 1 1970 ") + (dun-mprincl (nth x dun-room-shorts)))) + + (defun dun-ls-room () + (dun-mprincl "total 4 + drwxr-xr-x 3 root staff 512 Jan 1 1970 . + drwxr-xr-x 3 root staff 2048 Jan 1 1970 .. + -rwxr-xr-x 3 root staff 2048 Jan 1 1970 description") + (dolist (x (nth dun-cdroom dun-room-objects)) + (if (and (>= x 0) (not (= x 255))) + (progn + (dun-mprinc "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 ") + (dun-mprincl (nth x dun-objfiles)))))) + + (defun dun-ls-inven () + (dun-mprinc "total 467 + drwxr-xr-x 3 toukmond restricted 512 Jan 1 1970 . + drwxr-xr-x 3 root staff 2048 Jan 1 1970 ..") + (dolist (x dun-unix-verbs) + (if (not (eq (car x) 'IMPOSSIBLE)) + (progn + (dun-mprinc" + -rwxr-xr-x 1 toukmond restricted 10423 Jan 1 1970 ") + (dun-mprinc (car x))))) + (dun-mprinc "\n") + (if (not dun-uncompressed) + (dun-mprincl + "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 paper.o.Z")) + (dolist (x dun-inventory) + (dun-mprinc + "-rwxr-xr-x 1 toukmond restricted 0 Jan 1 1970 ") + (dun-mprincl (nth x dun-objfiles)))) + + (defun dun-echo (args) + (let (nomore var) + (setq nomore nil) + (dolist (x args) + (if (not nomore) + (progn + (if (not (string= (substring x 0 1) "$")) + (progn + (dun-mprinc x) + (dun-mprinc " ")) + (setq var (intern (substring x 1))) + (if (not (boundp var)) + (dun-mprinc " ") + (if (member var dun-restricted) + (progn + (dun-mprinc var) + (dun-mprinc ": Permission denied") + (setq nomore t)) + (eval (list 'dun-mprinc var)) + (dun-mprinc " "))))))) + (dun-mprinc "\n"))) + + + (defun dun-ftp (args) + (let (host username passwd ident newlist) + (if (not (car args)) + (dun-mprincl "ftp: hostname required on command line.") + (setq host (intern (car args))) + (if (not (member host '(gamma dun-endgame))) + (dun-mprincl "ftp: Unknown host.") + (if (eq host 'dun-endgame) + (dun-mprincl "ftp: connection to endgame not allowed") + (if (not dun-ethernet) + (dun-mprincl "ftp: host not responding.") + (dun-mprincl "Connected to gamma. FTP ver 0.9 00:00:00 01/01/70") + (dun-mprinc "Username: ") + (setq username (dun-read-line)) + (if (string= username "toukmond") + (if dun-batch-mode + (dun-mprincl "toukmond ftp access not allowed.") + (dun-mprincl "\ntoukmond ftp access not allowed.")) + (if (string= username "anonymous") + (if dun-batch-mode + (dun-mprincl + "Guest login okay, send your user ident as password.") + (dun-mprincl + "\nGuest login okay, send your user ident as password.")) + (if dun-batch-mode + (dun-mprinc "Password required for ") + (dun-mprinc "\nPassword required for ")) + (dun-mprincl username)) + (dun-mprinc "Password: ") + (setq ident (dun-read-line)) + (if (not (string= username "anonymous")) + (if dun-batch-mode + (dun-mprincl "Login failed.") + (dun-mprincl "\nLogin failed.")) + (if dun-batch-mode + (dun-mprincl + "Guest login okay, user access restrictions apply.") + (dun-mprincl + "\nGuest login okay, user access restrictions apply.")) + (dun-ftp-commands) + (setq newlist + '("What password did you use during anonymous ftp to gamma?")) + (setq newlist (append newlist (list ident))) + (rplaca (nthcdr 1 dun-endgame-questions) newlist))))))))) + + (defun dun-ftp-commands () + (setq dun-exitf nil) + (let (line) + (while (not dun-exitf) + (dun-mprinc "ftp> ") + (setq line (dun-read-line)) + (if + (eq + (dun-parse2 nil + '((type . dun-ftptype) (binary . dun-bin) (bin . dun-bin) + (send . dun-send) (put . dun-send) (quit . dun-ftpquit) + (help . dun-ftphelp)(ascii . dun-fascii) + ) line) + -1) + (dun-mprincl "No such command. Try help."))) + (setq dun-ftptype 'ascii))) + + (defun dun-ftptype (args) + (if (not (car args)) + (dun-mprincl "Usage: type [binary | ascii]") + (setq args (intern (car args))) + (if (eq args 'binary) + (dun-bin nil) + (if (eq args 'ascii) + (dun-fascii 'nil) + (dun-mprincl "Unknown type."))))) + + (defun dun-bin (args) + (dun-mprincl "Type set to binary.") + (setq dun-ftptype 'binary)) + + (defun dun-fascii (args) + (dun-mprincl "Type set to ascii.") + (setq dun-ftptype 'ascii)) + + (defun dun-ftpquit (args) + (setq dun-exitf t)) + + (defun dun-send (args) + (if (not (car args)) + (dun-mprincl "Usage: send ") + (setq args (car args)) + (let (counter foo) + (setq foo nil) + (setq counter 0) + + ;;; User can send commands! Stupid user. + + + (if (assq (intern args) dun-unix-verbs) + (progn + (rplaca (assq (intern args) dun-unix-verbs) 'IMPOSSIBLE) + (dun-mprinc "Sending ") + (dun-mprinc dun-ftptype) + (dun-mprinc " file for ") + (dun-mprincl args) + (dun-mprincl "Transfer complete.")) + + (dolist (x dun-objfiles) + (if (string= args x) + (progn + (if (not (member counter dun-inventory)) + (progn + (dun-mprincl "No such file.") + (setq foo t)) + (dun-mprinc "Sending ") + (dun-mprinc dun-ftptype) + (dun-mprinc " file for ") + (dun-mprinc (downcase (cadr (nth counter dun-objects)))) + (dun-mprincl ", (0 bytes)") + (if (not (eq dun-ftptype 'binary)) + (progn + (if (not (member obj-protoplasm + (nth receiving-room + dun-room-objects))) + (dun-replace dun-room-objects receiving-room + (append (nth receiving-room + dun-room-objects) + (list obj-protoplasm)))) + (dun-remove-obj-from-inven counter)) + (dun-remove-obj-from-inven counter) + (dun-replace dun-room-objects receiving-room + (append (nth receiving-room dun-room-objects) + (list counter)))) + (setq foo t) + (dun-mprincl "Transfer complete.")))) + (setq counter (+ 1 counter))) + (if (not foo) + (dun-mprincl "No such file.")))))) + + (defun dun-ftphelp (args) + (dun-mprincl + "Possible commands are:\nsend quit type ascii binary help")) + + (defun dun-uexit (args) + (setq dungeon-mode 'dungeon) + (dun-mprincl "\nYou step back from the console.") + (define-key dungeon-mode-map "\r" 'dun-parse) + (if (not dun-batch-mode) + (dun-messages))) + + (defun dun-pwd (args) + (dun-mprincl dun-cdpath)) + + (defun dun-uncompress (args) + (if (not (car args)) + (dun-mprincl "Usage: uncompress ") + (setq args (car args)) + (if (or dun-uncompressed + (and (not (string= args "paper.o")) + (not (string= args "paper.o.z")))) + (dun-mprincl "Uncompress command failed.") + (setq dun-uncompressed t) + (setq dun-inventory (append dun-inventory (list obj-paper)))))) + + (defun dun-rlogin (args) + (let (passwd) + (if (not (car args)) + (dun-mprincl "Usage: rlogin ") + (setq args (car args)) + (if (string= args "endgame") + (dun-rlogin-endgame) + (if (not (string= args "gamma")) + (dun-mprincl "No such host.") + (if (not dun-ethernet) + (dun-mprincl "Host not responding.") + (dun-mprinc "Password: ") + (setq passwd (dun-read-line)) + (if (not (string= passwd "worms")) + (dun-mprincl "\nlogin incorrect") + (dun-mprinc + "\nYou begin to feel strange for a moment, and you lose your items." + ) + (dun-replace dun-room-objects computer-room + (append (nth computer-room dun-room-objects) + dun-inventory)) + (setq dun-inventory nil) + (setq dun-current-room receiving-room) + (dun-uexit nil)))))))) + + (defun dun-cd (args) + (let (tcdpath tcdroom path-elemants room-check) + (if (not (car args)) + (dun-mprincl "Usage: cd ") + (setq tcdpath dun-cdpath) + (setq tcdroom dun-cdroom) + (setq dun-badcd nil) + (condition-case nil + (setq path-elements (dun-get-path (car args) nil)) + (error (dun-mprincl "Invalid path.") + (setq dun-badcd t))) + (dolist (pe path-elements) + (unless dun-badcd + (if (not (string= pe ".")) + (if (string= pe "..") + (progn + (if (> tcdroom 0) ;In a room + (progn + (setq tcdpath "/rooms") + (setq tcdroom -2)) + ;In /rooms,/usr,root + (if (or + (= tcdroom -2) (= tcdroom -4) + (= tcdroom -3)) + (progn + (setq tcdpath "/") + (setq tcdroom -3)) + (if (= tcdroom -10) ;In /usr/toukmond + (progn + (setq tcdpath "/usr") + (setq tcdroom -4)))))) + (if (string= pe "/") + (progn + (setq tcdpath "/") + (setq tcdroom -3)) + (if (= tcdroom -4) + (if (string= pe "toukmond") + (progn + (setq tcdpath "/usr/toukmond") + (setq tcdroom -10)) + (dun-nosuchdir)) + (if (= tcdroom -10) + (dun-nosuchdir) + (if (> tcdroom 0) + (dun-nosuchdir) + (if (= tcdroom -3) + (progn + (if (string= pe "rooms") + (progn + (setq tcdpath "/rooms") + (setq tcdroom -2)) + (if (string= pe "usr") + (progn + (setq tcdpath "/usr") + (setq tcdroom -4)) + (dun-nosuchdir)))) + (if (= tcdroom -2) + (progn + (dolist (x dun-visited) + (setq room-check + (nth x + dun-room-shorts)) + (if (string= room-check pe) + (progn + (setq tcdpath + (concat "/rooms/" room-check)) + (setq tcdroom x)))) + (if (= tcdroom -2) + (dun-nosuchdir))))))))))))) + (if (not dun-badcd) + (progn + (setq dun-cdpath tcdpath) + (setq dun-cdroom tcdroom) + 0) + -2)))) + + (defun dun-nosuchdir () + (dun-mprincl "No such directory.") + (setq dun-badcd t)) + + (defun dun-cat (args) + (let (doto checklist) + (if (not (setq args (car args))) + (dun-mprincl "Usage: cat ") + (if (string-match "/" args) + (dun-mprincl "cat: only files in current directory allowed.") + (if (and (> dun-cdroom 0) (string= args "description")) + (dun-mprincl (car (nth dun-cdroom dun-rooms))) + (if (setq doto (string-match "\\.o" args)) + (progn + (if (= dun-cdroom -10) + (setq checklist dun-inventory) + (setq checklist (nth dun-cdroom dun-room-objects))) + (if (not (member (cdr + (assq (intern + (substring args 0 doto)) + dun-objnames)) + checklist)) + (dun-mprincl "File not found.") + (dun-mprincl "Ascii files only."))) + (if (assq (intern args) dun-unix-verbs) + (dun-mprincl "Ascii files only.") + (dun-mprincl "File not found.")))))))) + + (defun dun-zippy (args) + (dun-mprincl (yow))) + + (defun dun-rlogin-endgame () + (if (not (= (dun-score nil) 90)) + (dun-mprincl + "You have not achieved enough points to connect to endgame.") + (dun-mprincl"\nWelcome to the endgame. You are a truly noble adventurer.") + (setq dun-current-room treasure-room) + (setq dun-endgame t) + (dun-replace dun-room-objects endgame-treasure-room (list obj-bill)) + (dun-uexit nil))) + + + (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)) + + ;;;; + ;;;; This section defines the DOS emulation functions for dunnet + ;;;; + + (defun dun-dos-parse (args) + (interactive "*p") + (beginning-of-line) + (let (beg) + (setq beg (+ (point) 3)) + (end-of-line) + (if (not (= beg (point))) + (let (line) + (setq line (downcase (buffer-substring beg (point)))) + (princ line) + (if (eq (dun-parse2 nil dun-dos-verbs line) -1) + (progn + (sleep-for 1) + (dun-mprincl "Bad command or file name")))) + (goto-char (point-max)) + (dun-mprinc "\n")) + (if (eq dungeon-mode 'dos) + (progn + (dun-fix-screen) + (dun-dos-prompt))))) + + (defun dun-dos-interface () + (dun-dos-boot-msg) + (setq dungeon-mode 'dos) + (define-key dungeon-mode-map "\r" 'dun-dos-parse) + (dun-dos-prompt)) + + (defun dun-dos-type (args) + (sleep-for 2) + (if (setq args (car args)) + (if (string= args "foo.txt") + (dun-dos-show-combination) + (if (string= args "command.com") + (dun-mprincl "Cannot type binary files") + (dun-mprinc "File not found - ") + (dun-mprincl (upcase args)))) + (dun-mprincl "Must supply file name"))) + + (defun dun-dos-invd (args) + (sleep-for 1) + (dun-mprincl "Invalid drive specification")) + + (defun dun-dos-dir (args) + (sleep-for 1) + (if (or (not (setq args (car args))) (string= args "\\")) + (dun-mprincl " + Volume in drive A is FOO + Volume Serial Number is 1A16-08C9 + Directory of A:\\ + + COMMAND COM 47845 04-09-91 2:00a + FOO TXT 40 01-20-93 1:01a + 2 file(s) 47845 bytes + 1065280 bytes free + ") + (dun-mprincl " + Volume in drive A is FOO + Volume Serial Number is 1A16-08C9 + Directory of A:\\ + + File not found"))) + + + (defun dun-dos-prompt () + (dun-mprinc "A> ")) + + (defun dun-dos-boot-msg () + (sleep-for 3) + (dun-mprinc "Current time is ") + (dun-mprincl (substring (current-time-string) 12 20)) + (dun-mprinc "Enter new time: ") + (dun-read-line) + (if (not dun-batch-mode) + (dun-mprinc "\n"))) + + (defun dun-dos-spawn (args) + (sleep-for 1) + (dun-mprincl "Cannot spawn subshell")) + + (defun dun-dos-exit (args) + (setq dungeon-mode 'dungeon) + (dun-mprincl "\nYou power down the machine and step back.") + (define-key dungeon-mode-map "\r" 'dun-parse) + (if (not dun-batch-mode) + (dun-messages))) + + (defun dun-dos-no-disk () + (sleep-for 3) + (dun-mprincl "Boot sector not found")) + + + (defun dun-dos-show-combination () + (sleep-for 2) + (dun-mprinc "\nThe combination is ") + (dun-mprinc dun-combination) + (dun-mprinc ".\n")) + + (defun dun-dos-nil (args)) + + + ;;;; + ;;;; This section defines the save and restore game functions for dunnet. + ;;;; + + (defun dun-save-game (filename) + (if (not (setq filename (car filename))) + (dun-mprincl "You must supply a filename for the save.") + (if (file-exists-p filename) + (delete-file filename)) + (setq dun-numsaves (1+ dun-numsaves)) + (dun-make-save-buffer) + (dun-save-val "dun-current-room") + (dun-save-val "dun-computer") + (dun-save-val "dun-combination") + (dun-save-val "dun-visited") + (dun-save-val "dun-diggables") + (dun-save-val "dun-key-level") + (dun-save-val "dun-floppy") + (dun-save-val "dun-numsaves") + (dun-save-val "dun-numcmds") + (dun-save-val "dun-logged-in") + (dun-save-val "dungeon-mode") + (dun-save-val "dun-jar") + (dun-save-val "dun-lastdir") + (dun-save-val "dun-black") + (dun-save-val "dun-nomail") + (dun-save-val "dun-unix-verbs") + (dun-save-val "dun-hole") + (dun-save-val "dun-uncompressed") + (dun-save-val "dun-ethernet") + (dun-save-val "dun-sauna-level") + (dun-save-val "dun-room-objects") + (dun-save-val "dun-room-silents") + (dun-save-val "dun-inventory") + (dun-save-val "dun-endgame-question") + (dun-save-val "dun-endgame") + (dun-save-val "dun-cdroom") + (dun-save-val "dun-cdpath") + (dun-save-val "dun-correct-answer") + (dun-save-val "dun-inbus") + (if (dun-compile-save-out filename) + (dun-mprincl "Error saving to file.") + (dun-do-logfile 'save nil) + (switch-to-buffer "*dungeon*") + (princ "") + (dun-mprincl "Done.")))) + + (defun dun-make-save-buffer () + (switch-to-buffer (get-buffer-create "*save-dungeon*")) + (erase-buffer)) + + (defun dun-compile-save-out (filename) + (let (ferror) + (setq ferror nil) + (condition-case nil + (dun-rot13) + (error (setq ferror t))) + (if (not ferror) + (progn + (goto-char (point-min)))) + (condition-case nil + (write-region 1 (point-max) filename nil 1) + (error (setq ferror t))) + (kill-buffer (current-buffer)) + ferror)) + + + (defun dun-save-val (varname) + (let (value) + (setq varname (intern varname)) + (setq value (eval varname)) + (dun-minsert "(setq ") + (dun-minsert varname) + (dun-minsert " ") + (if (or (listp value) + (symbolp value)) + (dun-minsert "'")) + (if (stringp value) + (dun-minsert "\"")) + (dun-minsert value) + (if (stringp value) + (dun-minsert "\"")) + (dun-minsertl ")"))) + + + (defun dun-restore (args) + (let (file) + (if (not (setq file (car args))) + (dun-mprincl "You must supply a filename.") + (if (not (dun-load-d file)) + (dun-mprincl "Could not load restore file.") + (dun-mprincl "Done.") + (setq room 0))))) + + + (defun dun-do-logfile (type how) + (let (ferror newscore) + (setq ferror nil) + (switch-to-buffer (get-buffer-create "*score*")) + (erase-buffer) + (condition-case nil + (insert-file-contents dun-log-file) + (error (setq ferror t))) + (unless ferror + (goto-char (point-max)) + (dun-minsert (current-time-string)) + (dun-minsert " ") + (dun-minsert (user-login-name)) + (dun-minsert " ") + (if (eq type 'save) + (dun-minsert "saved ") + (if (= (dun-endgame-score) 110) + (dun-minsert "won ") + (if (not how) + (dun-minsert "quit ") + (dun-minsert "killed by ") + (dun-minsert how) + (dun-minsert " ")))) + (dun-minsert "at ") + (dun-minsert (cadr (nth (abs room) dun-rooms))) + (dun-minsert ". score: ") + (if (> (dun-endgame-score) 0) + (dun-minsert (setq newscore (+ 90 (dun-endgame-score)))) + (dun-minsert (setq newscore (dun-reg-score)))) + (dun-minsert " saves: ") + (dun-minsert dun-numsaves) + (dun-minsert " commands: ") + (dun-minsert dun-numcmds) + (dun-minsert "\n") + (write-region 1 (point-max) dun-log-file nil 1)) + (kill-buffer (current-buffer)))) + + + ;;;; + ;;;; These are functions, and function re-definitions so that dungeon can + ;;;; be run in batch mode. + + + (defun dun-batch-mprinc (arg) + (if (stringp arg) + (send-string-to-terminal arg) + (send-string-to-terminal (prin1-to-string arg)))) + + + (defun dun-batch-mprincl (arg) + (if (stringp arg) + (progn + (send-string-to-terminal arg) + (send-string-to-terminal "\n")) + (send-string-to-terminal (prin1-to-string arg)) + (send-string-to-terminal "\n"))) + + (defun dun-batch-parse (dun-ignore dun-verblist line) + (setq line-list (dun-listify-string (concat line " "))) + (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) + + (defun dun-batch-parse2 (dun-ignore dun-verblist line) + (setq line-list (dun-listify-string2 (concat line " "))) + (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list))) + + (defun dun-batch-read-line () + (read-from-minibuffer "" nil dungeon-batch-map)) + + + (defun dun-batch-loop () + (setq dun-dead nil) + (setq room 0) + (while (not dun-dead) + (if (eq dungeon-mode 'dungeon) + (progn + (if (not (= room dun-current-room)) + (progn + (dun-describe-room dun-current-room) + (setq room dun-current-room))) + (dun-mprinc ">") + (setq line (downcase (dun-read-line))) + (if (eq (dun-vparse dun-ignore dun-verblist line) -1) + (dun-mprinc "I don't understand that.\n")))))) + + (defun dun-batch-dos-interface () + (dun-dos-boot-msg) + (setq dungeon-mode 'dos) + (while (eq dungeon-mode 'dos) + (dun-dos-prompt) + (setq line (downcase (dun-read-line))) + (if (eq (dun-parse2 nil dun-dos-verbs line) -1) + (progn + (sleep-for 1) + (dun-mprincl "Bad command or file name")))) + (goto-char (point-max)) + (dun-mprinc "\n")) + + (defun dun-batch-unix-interface () + (dun-login) + (if dun-logged-in + (progn + (setq dungeon-mode 'unix) + (while (eq dungeon-mode 'unix) + (dun-mprinc "$ ") + (setq line (downcase (dun-read-line))) + (if (eq (dun-parse2 nil dun-unix-verbs line) -1) + (let (esign) + (if (setq esign (string-match "=" line)) + (dun-doassign line esign) + (dun-mprinc (car line-list)) + (dun-mprincl ": not found."))))) + (goto-char (point-max)) + (dun-mprinc "\n")))) + + (defun dungeon-nil (arg) + "noop" + (interactive "*p")) + + (defun dun-batch-dungeon () + (load "dun-batch") + (setq dun-visited '(27)) + (dun-mprinc "\n") + (dun-batch-loop)) + + (unless (not noninteractive) + (fset 'dun-mprinc 'dun-batch-mprinc) + (fset 'dun-mprincl 'dun-batch-mprincl) + (fset 'dun-vparse 'dun-batch-parse) + (fset 'dun-parse2 'dun-batch-parse2) + (fset 'dun-read-line 'dun-batch-read-line) + (fset 'dun-dos-interface 'dun-batch-dos-interface) + (fset 'dun-unix-interface 'dun-batch-unix-interface) + (dun-mprinc "\n") + (setq dun-batch-mode t) + (dun-batch-loop)) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/faces.el emacs-19.17/lisp/faces.el *** emacs-19.16/lisp/faces.el Sat Jul 3 21:41:25 1993 --- emacs-19.17/lisp/faces.el Sun Jul 18 02:19:04 1993 *************** *** 288,299 **** face) ! (defun copy-face (old-face new-name &optional frame) "Define a face just like OLD-FACE, with name NEW-NAME. If NEW-NAME already exists as a face, it is modified to be like OLD-FACE. If the optional argument FRAME is given, this applies only to that frame. ! Otherwise it applies to each frame separately." (setq old-face (internal-get-face old-face frame)) (let* ((inhibit-quit t) ! (new-face (or (internal-find-face new-name frame) (make-face new-name)))) (if (null frame) --- 288,303 ---- face) ! (defun copy-face (old-face new-name &optional frame new-frame) "Define a face just like OLD-FACE, with name NEW-NAME. If NEW-NAME already exists as a face, it is modified to be like OLD-FACE. If the optional argument FRAME is given, this applies only to that frame. ! Otherwise it applies to each frame separately. ! If the optional fourth argument NEW-FRAME is given, ! copy the information from face OLD-FACE on frame FRAME ! to face NEW-NAME on frame NEW-FRAME." ! (or new-frame (setq new-frame frame)) (setq old-face (internal-get-face old-face frame)) (let* ((inhibit-quit t) ! (new-face (or (internal-find-face new-name new-frame) (make-face new-name)))) (if (null frame) *************** *** 303,313 **** (setq frames (cdr frames))) (copy-face old-face new-name t)) ! (set-face-font new-face (face-font old-face frame) frame) ! (set-face-foreground new-face (face-foreground old-face frame) frame) ! (set-face-background new-face (face-background old-face frame) frame) ;;; (set-face-background-pixmap ! ;;; new-face (face-background-pixmap old-face frame) frame) (set-face-underline-p new-face (face-underline-p old-face frame) ! frame)) new-face)) --- 307,317 ---- (setq frames (cdr frames))) (copy-face old-face new-name t)) ! (set-face-font new-face (face-font old-face frame) new-frame) ! (set-face-foreground new-face (face-foreground old-face frame) new-frame) ! (set-face-background new-face (face-background old-face frame) new-frame) ;;; (set-face-background-pixmap ! ;;; new-face (face-background-pixmap old-face frame) new-frame) (set-face-underline-p new-face (face-underline-p old-face frame) ! new-frame)) new-face)) *************** *** 319,324 **** (equal (face-background face1 frame) (face-background face2 frame)) (equal (face-font face1 frame) (face-font face2 frame)) ! (equal (face-background-pixmap face1 frame) ! (face-background-pixmap face2 frame)))) (defun face-differs-from-default-p (face &optional frame) --- 323,329 ---- (equal (face-background face1 frame) (face-background face2 frame)) (equal (face-font face1 frame) (face-font face2 frame)) ! ;; (equal (face-background-pixmap face1 frame) ! ;; (face-background-pixmap face2 frame)) ! )) (defun face-differs-from-default-p (face &optional frame) *************** *** 621,624 **** --- 626,673 ---- (and (not noerror) (error "No unitalic version of %S" font1))))) + + (defvar list-faces-sample-text + "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ" + "*Text string to display as the sample text for `list-faces-display'.") + + ;; The name list-faces would be more consistent, but let's avoid a conflict + ;; with Lucid, which uses that name differently. + (defun list-faces-display () + "List all faces, using the same sample text in each. + The sample text is a string that comes from the variable + `list-faces-sample-text'. + + It is possible to give a particular face name different appearances in + different frames. This command shows the appearance in the + selected frame." + (interactive) + (let ((faces (sort (face-list) (function string-lessp))) + (face nil) + (frame (selected-frame)) + disp-frame window) + (with-output-to-temp-buffer "*Faces*" + (save-excursion + (set-buffer standard-output) + (setq truncate-lines t) + (while faces + (setq face (car faces)) + (setq faces (cdr faces)) + (insert (format "%25s " (symbol-name face))) + (let ((beg (point))) + (insert list-faces-sample-text) + (insert "\n") + (put-text-property beg (1- (point)) 'face face))) + (goto-char (point-min)))) + ;; If the *Faces* buffer appears in a different frame, + ;; copy all the face definitions from FRAME, + ;; so that the display will reflect the frame that was selected. + (setq window (get-buffer-window (get-buffer "*Faces*") t)) + (setq disp-frame (if window (window-frame window) + (car (frame-list)))) + (or (eq frame disp-frame) + (let ((faces (face-list))) + (while faces + (copy-face (car faces) (car faces) frame disp-frame) + (setq faces (cdr faces))))))) ;;; Make the default and modeline faces; the C code knows these as diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/files.el emacs-19.17/lisp/files.el *** emacs-19.16/lisp/files.el Sat Jul 3 15:43:19 1993 --- emacs-19.17/lisp/files.el Sun Jul 18 02:40:06 1993 *************** *** 256,260 **** (defun cd-absolute (dir) "Change current directory to given absolute file name DIR." ! (setq dir (expand-file-name dir)) (if (not (eq system-type 'vax-vms)) (setq dir (file-name-as-directory dir))) --- 256,260 ---- (defun cd-absolute (dir) "Change current directory to given absolute file name DIR." ! (setq dir (abbreviate-file-name (expand-file-name dir))) (if (not (eq system-type 'vax-vms)) (setq dir (file-name-as-directory dir))) *************** *** 1322,1328 **** "Convert FILENAME to be relative to DIRECTORY (default: default-directory)." (setq filename (expand-file-name filename) ! directory (file-name-as-directory (if directory ! (expand-file-name directory) ! default-directory))) (file-relative-name-1 directory)) --- 1322,1327 ---- "Convert FILENAME to be relative to DIRECTORY (default: default-directory)." (setq filename (expand-file-name filename) ! directory (file-name-as-directory (expand-file-name ! (or directory default-directory)))) (file-relative-name-1 directory)) *************** *** 1484,1488 **** ;; delete it now. (delete-auto-save-file-if-necessary recent-save) ! (run-hooks 'after-save-hooks)) (message "(No changes need to be saved)"))) --- 1483,1487 ---- ;; delete it now. (delete-auto-save-file-if-necessary recent-save) ! (run-hooks 'after-save-hook)) (message "(No changes need to be saved)"))) *************** *** 1854,1858 **** ;; - variable dired-subdir-regexp (defun insert-directory (file switches &optional wildcard full-directory-p) ! "Insert directory listing for of FILE, formatted according to SWITCHES. Leaves point after the inserted text. Optional third arg WILDCARD means treat FILE as shell wildcard. --- 1853,1857 ---- ;; - variable dired-subdir-regexp (defun insert-directory (file switches &optional wildcard full-directory-p) ! "Insert directory listing for FILE, formatted according to SWITCHES. Leaves point after the inserted text. Optional third arg WILDCARD means treat FILE as shell wildcard. *************** *** 1875,1890 **** " -d " switches " " (file-name-nondirectory file)))) ! ;; Barry Margolin says: "SunOS 4.1.3 (and SV and POSIX?) ! ;; lists the link if we give a link to a directory - yuck!" ! ;; That's why we used to chase symlinks. But we don't want ! ;; to chase links before passing the filename to ls; that ! ;; would mean that our line of output would not display ! ;; FILE's name as given. To really address the problem that ! ;; SunOS 4.1.3 has, we need to find the right switch to get ! ;; a description of the link itself. ! ;; (let (symlink) ! ;; (while (setq symlink (file-symlink-p file)) ! ;; (setq file symlink))) ! (call-process insert-directory-program nil t nil switches file)))))) (defun save-buffers-kill-emacs (&optional arg) --- 1874,1883 ---- " -d " switches " " (file-name-nondirectory file)))) ! ;; SunOS 4.1.3, SVr4 and others need the "." to list the ! ;; directory if FILE is a symbolic link. ! (call-process insert-directory-program nil t nil switches ! (if full-directory-p ! (concat (file-name-as-directory file) ".") ! file))))))) (defun save-buffers-kill-emacs (&optional arg) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/font-lock.el emacs-19.17/lisp/font-lock.el *** emacs-19.16/lisp/font-lock.el --- emacs-19.17/lisp/font-lock.el Fri Jul 9 16:28:05 1993 *************** *** 0 **** --- 1,590 ---- + ;; Electric Font Lock Mode + ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. + + ;; Author: jwz, then rms + ;; Maintainer: FSF + ;; Keywords: languages, faces + + ;; 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: + + ;; Font-lock-mode is a minor mode that causes your comments to be + ;; displayed in one face, strings in another, reserved words in another, + ;; documentation strings in another, and so on. + ;; + ;; Comments will be displayed in `font-lock-comment-face'. + ;; Strings will be displayed in `font-lock-string-face'. + ;; Doc strings will be displayed in `font-lock-doc-string-face'. + ;; Function and variable names (in their defining forms) will be + ;; displayed in `font-lock-function-name-face'. + ;; Reserved words will be displayed in `font-lock-keyword-face'. + ;; + ;; To make the text you type be fontified, use M-x font-lock-mode. + ;; When this minor mode is on, the fonts of the current line are + ;; updated with every insertion or deletion. + ;; + ;; To define new reserved words or other patterns to highlight, use + ;; the `font-lock-keywords' variable. This should be mode-local. + ;; + ;; To turn this on automatically, add this to your .emacs file: + ;; + ;; (setq emacs-lisp-mode-hook '(lambda () (font-lock-mode 1))) + ;; + ;; On a Sparc2, the initial fontification takes about 12 seconds for a 120k + ;; file of C code, using the default configuration. You can speed this up + ;; substantially by removing some of the patterns that are highlighted by + ;; default. Fontifying Lisp code is significantly faster, because Lisp has a + ;; more regular syntax than C, so the expressions don't have to be as hairy. + + ;;; Code: + + (or (internal-find-face 'underline) + (copy-face 'default 'underline)) + (set-face-underline-p 'underline t) + + (defvar font-lock-comment-face + 'italic + "Face to use for comments.") + + (defvar font-lock-doc-string-face + 'italic + "Face to use for documentation strings.") + + (defvar font-lock-string-face + 'underline + "Face to use for string constants.") + + (defvar font-lock-function-face + 'bold-italic + "Face to use for function names.") + + (defvar font-lock-keyword-face + 'bold + "Face to use for keywords.") + + (defvar font-lock-type-face + 'italic + "Face to use for data types.") + + (make-variable-buffer-local 'font-lock-keywords) + (defvar font-lock-keywords nil + "*The keywords to highlight. + If this is a list, then elements may be of the forms: + + \"string\" ; a regexp to highlight in the + ; `font-lock-keyword-face'. + (\"string\" . integer) ; match N of the regexp will be highlighted + (\"string\" . face-name) ; use the named face + (\"string\" integer face-name) ; both of the above + (\"string\" integer face-name t) ; this allows highlighting to overlap + ; with already-highlighted regions. + + These regular expressions should not match text which spans lines. + While \\[font-lock-fontify-buffer] handles multi-line patterns correctly, + updating when you edit the buffer does not, + since it considers text one line at a time. + + Be careful composing regexps for this list; the wrong pattern can dramatically + slow things down!") + + (defvar font-lock-keywords-case-fold-search nil + "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.") + + (defvar font-lock-verbose t + "*Non-nil means `font-lock-fontify-buffer' should print status messages.") + + ;;;###autoload + (defvar font-lock-mode-hook nil + "Function or functions to run on entry to Font Lock mode.") + + ;;; These variables record, for each buffer, + ;;; the parse state at a particular position, always the start of a line. + ;;; This is used to make font-lock-fontify-region faster. + (defvar font-lock-cache-position nil) + (defvar font-lock-cache-state nil) + (make-variable-buffer-local 'font-lock-cache-position) + (make-variable-buffer-local 'font-lock-cache-state) + + (defun font-lock-fontify-region (start end) + "Put proper face on each string and comment between START and END." + (save-excursion + (goto-char start) + (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)) + (if (eq (point) font-lock-cache-position) + (setq state font-lock-cache-state) + ;; Find outermost containing sexp. + (beginning-of-defun) + ;; Find the state at STARTLINE. + (while (< (point) startline) + (setq state (parse-partial-sexp (point) startline 0))) + (setq font-lock-cache-state state + font-lock-cache-position (point))) + ;; Now find the state precisely at START. + (setq state (parse-partial-sexp (point) start nil nil state)) + ;; If the region starts inside a string, show the extent of it. + (if (nth 3 state) + (let ((beg (point))) + (while (and (re-search-forward "\\s\"" end 'move) + (nth 3 (parse-partial-sexp beg (point) + nil nil state)))) + (put-text-property beg (point) 'face font-lock-string-face) + (setq state (parse-partial-sexp beg (point) nil nil state)))) + ;; Likewise for a comment. + (if (or (nth 4 state) (nth 7 state)) + (let ((beg (point))) + (while (and (re-search-forward (if comment-end + (concat "\\s>\\|" + (regexp-quote comment-end)) + "\\s>") + end 'move) + (nth 3 (parse-partial-sexp beg (point) + nil nil state)))) + (put-text-property beg (point) 'face font-lock-comment-face) + (setq state (parse-partial-sexp beg (point) nil nil state)))) + ;; Find each interesting place between here and END. + (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) + ;; Verify the state at that place + ;; so we don't get fooled by \" or \;. + (setq state (parse-partial-sexp prev (point) + nil nil state))) + (let ((here (point))) + (if (or (nth 4 state) (nth 7 state)) + ;; We found a real comment start. + (let ((beg (match-beginning 0))) + (goto-char beg) + (save-restriction + (narrow-to-region (point-min) end) + (condition-case nil + (progn + (forward-comment 1) + ;; forward-comment skips all whitespace, + ;; so go back to the real end of the comment. + (skip-chars-backward " \t")) + (error (goto-char end)))) + (put-text-property beg (point) 'face font-lock-comment-face) + (setq state (parse-partial-sexp here (point) nil nil state))) + (if (nth 3 state) + (let ((beg (match-beginning 0))) + (while (and (re-search-forward "\\s\"" end 'move) + (nth 3 (parse-partial-sexp here (point) + nil nil state)))) + (put-text-property beg (point) 'face font-lock-string-face) + (setq state (parse-partial-sexp here (point) nil nil state)))) + )) + ;; Make sure PREV is non-nil after the loop + ;; only if it was set on the very last iteration. + (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. + ;; It is probably not needed due to later changes to handle strings + ;; starting before the region in question. + ;; (if (and (null (nth 3 state)) + ;; (eq (char-syntax (preceding-char)) ?\") + ;; (save-excursion + ;; (nth 3 (parse-partial-sexp prev (1- (point)) + ;; nil nil prevstate)))) + ;; ;; We found the end of a string. + ;; (save-excursion + ;; (setq foo2 (point)) + ;; (let ((ept (point))) + ;; (forward-sexp -1) + ;; ;; Highlight the string when we see the end. + ;; ;; Doing it at the start leads to trouble: + ;; ;; either it fails to handle multiline strings + ;; ;; or it can run away when an unmatched " is inserted. + ;; (put-text-property (point) ept 'face + ;; (if (= (car state) 1) + ;; font-lock-doc-string-face + ;; font-lock-string-face))))) + + (defun font-lock-unfontify-region (beg end) + (remove-text-properties beg end '(face nil))) + + ;; Called when any modification is made to buffer text. + (defun font-lock-after-change-function (beg end old-len) + (save-excursion + (save-match-data + (goto-char beg) + ;; Discard the cache info if text before it has changed. + (and font-lock-cache-position + (> font-lock-cache-position beg) + (setq font-lock-cache-position nil)) + ;; Rescan till end of line. yes! + (goto-char end) + (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)))) + + ;;; Fontifying arbitrary patterns + + (defsubst font-lock-any-properties-p (start end) + (or (get-text-property start 'font-lock) + (let ((next (next-single-property-change start 'font-lock))) + (and next (< next end))))) + + (defun font-lock-hack-keywords (start end &optional loudly) + (goto-char start) + (let ((case-fold-search font-lock-keywords-case-fold-search) + (rest font-lock-keywords) + (count 0) + first str match face s e allow-overlap-p) + (while rest + (setq first (car rest) rest (cdr rest)) + (goto-char start) + (cond ((consp first) + (setq str (car first)) + (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) + allow-overlap-p nil + face font-lock-keyword-face)))) + (t + (setq str first match 0 allow-overlap-p nil + face font-lock-keyword-face))) + ;(message "regexp: %s" str) + (while (re-search-forward str end t) + (setq s (match-beginning match) + e (match-end match)) + (or s (error "expression did not match subexpression %d" match)) + ;; don't fontify this keyword if we're already in some other context. + (or (if allow-overlap-p nil (font-lock-any-properties-p s e)) + (progn + (put-text-property s e 'face face)))) + (if loudly (message "Fontifying %s... (regexps...%s)" + (buffer-name) + (make-string (setq count (1+ count)) ?.)))))) + + + ;; The user level functions + + (defvar font-lock-mode nil) ; for modeline + (or (assq 'font-lock-mode minor-mode-alist) + (setq minor-mode-alist + (append minor-mode-alist + '((font-lock-mode " Font"))))) + + (defvar font-lock-fontified nil) ; whether we have hacked this buffer + (put 'font-lock-fontified 'permanent-local t) + + ;;;###autoload + (defun font-lock-mode (&optional arg) + "Toggle Font Lock mode. + With arg, turn Font Lock mode on if and only if arg is positive. + + When Font Lock mode is enabled, text is fontified as you type it: + + - comments are displayed in `font-lock-comment-face'; + (That is a variable whose value should be a face name.) + - strings are displayed in `font-lock-string-face'; + - documentation strings are displayed in `font-lock-doc-string-face'; + - function and variable names in their defining forms are displayed + in `font-lock-function-name-face'; + - and certain other expressions are displayed in other faces + according to the value of the variable `font-lock-keywords'. + + When you turn Font Lock mode on/off, the buffer is fontified/defontified. + To fontify a buffer without having newly typed text become fontified, you + can use \\[font-lock-fontify-buffer]." + (interactive "P") + (let ((on-p (if (null arg) + (not font-lock-mode) + (> (prefix-numeric-value arg) 0)))) + (if (equal (buffer-name) " *Compiler Input*") ; hack for bytecomp... + (setq on-p nil)) + (or (memq after-change-function + '(nil font-lock-after-change-function)) + (error "after-change-function is %s" after-change-function)) + (set (make-local-variable 'after-change-function) + (if on-p 'font-lock-after-change-function nil)) + (set (make-local-variable 'font-lock-mode) on-p) + (cond (on-p + (font-lock-set-defaults) + (run-hooks 'font-lock-mode-hook) + (or font-lock-fontified (font-lock-fontify-buffer))) + (font-lock-fontified + (setq font-lock-fontified nil) + (font-lock-unfontify-region (point-min) (point-max)))) + (force-mode-line-update))) + + + (defun font-lock-fontify-buffer () + "Fontify the current buffer the way `font-lock-mode' would: + + - comments are displayed in `font-lock-comment-face'; + - strings are displayed in `font-lock-string-face'; + - documentation strings are displayed in `font-lock-doc-string-face'; + - function and variable names in their defining forms are displayed + in `font-lock-function-name-face'; + - and certain other expressions are displayed in other faces + according to the value of the variable `font-lock-keywords'. + + This can take a while for large buffers." + (interactive) + (let ((was-on font-lock-mode) + (font-lock-verbose (or font-lock-verbose (interactive-p)))) + (if font-lock-verbose (message "Fontifying %s..." (buffer-name))) + ;; Turn it on to run hooks and get the right font-lock-keywords. + (or was-on (font-lock-mode 1)) + (font-lock-unfontify-region (point-min) (point-max)) + (if font-lock-verbose (message "Fontifying %s... (syntactically...)" + (buffer-name))) + ;; (buffer-syntactic-context-flush-cache) + (save-excursion + (font-lock-fontify-region (point-min) (point-max)) + (if font-lock-verbose (message "Fontifying %s... (regexps...)" + (buffer-name))) + (font-lock-hack-keywords (point-min) (point-max) font-lock-verbose)) + (or was-on (font-lock-mode 0)) ; turn it off if it was off. + (set (make-local-variable 'font-lock-fontified) t) + (if font-lock-verbose (message "Fontifying %s... done." (buffer-name))) + )) + + + ;;; Various mode-specific information. + + (defun font-lock-set-defaults () + "sets font-lock-keywords to something appropriate for this mode." + (setq font-lock-keywords + (cond ((eq major-mode 'lisp-mode) lisp-font-lock-keywords) + ((eq major-mode 'emacs-lisp-mode) lisp-font-lock-keywords) + ((eq major-mode 'c-mode) c-font-lock-keywords) + ((eq major-mode 'c++-c-mode) c-font-lock-keywords) + ((eq major-mode 'c++-mode) c++-font-lock-keywords) + ((eq major-mode 'perl-mode) perl-font-lock-keywords) + ((eq major-mode 'tex-mode) tex-font-lock-keywords) + ((eq major-mode 'texinfo-mode) texi-font-lock-keywords) + (t nil)))) + + (defconst lisp-font-lock-keywords-1 + '(;; + ;; highlight defining forms. This doesn't work too nicely for + ;; (defun (setf foo) ...) but it does work for (defvar foo) which + ;; is more important. + ("^(def[-a-z]+\\s +\\([^ \t\n\)]+\\)" 1 font-lock-function-name-face) + ;; + ;; highlight CL keywords + ("\\s :\\(\\(\\sw\\|\\s_\\)+\\)\\>" . 1) + ;; + ;; this is highlights things like (def* (setf foo) (bar baz)), but may + ;; be slower (I haven't really thought about it) + ; ("^(def[-a-z]+\\s +\\(\\s(\\S)*\\s)\\|\\S(\\S *\\)" + ; 1 font-lock-function-name-face) + ) + "For consideration as a value of `lisp-font-lock-keywords'. + This does fairly subdued highlighting.") + + (defconst lisp-font-lock-keywords-2 + (append + lisp-font-lock-keywords-1 + '(;; + ;; Highlight control structures + ("(\\(cond\\|if\\|when\\|unless\\|[ec]?\\(type\\)?case\\)[ \t\n]" . 1) + ("(\\(while\\|do\\|let*?\\|flet\\|labels\\|prog[nv12*]?\\)[ \t\n]" . 1) + ("(\\(catch\\|\\throw\\|block\\|return\\|return-from\\)[ \t\n]" . 1) + ("(\\(save-restriction\\|save-window-restriction\\)[ \t\n]" . 1) + ("(\\(save-excursion\\|unwind-protect\\|condition-case\\)[ \t\n]" . 1) + ;; + ;; highlight function names in emacs-lisp docstrings (in the syntax + ;; that substitute-command-keys understands.) + ("\\\\\\\\\\[\\([^]\\\n]+\\)]" 1 font-lock-keyword-face t) + ;; + ;; highlight words inside `' which tend to be function names + ("`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'" + 1 font-lock-keyword-face t) + )) + "For consideration as a value of `lisp-font-lock-keywords'. + This does a lot more highlighting.") + + ;; default to the gaudier variety? + ;(defvar lisp-font-lock-keywords lisp-font-lock-keywords-2 + ; "Additional expressions to highlight in Lisp modes.") + (defvar lisp-font-lock-keywords lisp-font-lock-keywords-1 + "Additional expressions to highlight in Lisp modes.") + + + (defconst c-font-lock-keywords-1 nil + "For consideration as a value of `c-font-lock-keywords'. + This does fairly subdued highlighting.") + + (defconst c-font-lock-keywords-2 nil + "For consideration as a value of `c-font-lock-keywords'. + This does a lot more highlighting.") + + (let ((storage "auto\\|extern\\|register\\|static\\|volatile") + (prefixes "unsigned\\|short\\|long") + (types (concat "int\\|char\\|float\\|double\\|void\\|struct\\|" + "union\\|enum\\|typedef")) + (ctoken "[a-zA-Z0-9_:~*]+") + ) + (setq c-font-lock-keywords-1 + (list + ;; fontify preprocessor directives as comments. + '("^#[ \t]*[a-z]+" . font-lock-comment-face) + ;; + ;; fontify names being defined. + '("^#[ \t]*\\(define\\|undef\\)[ \t]+\\(\\(\\sw\\|\\s_\\)+\\)" 2 + font-lock-function-name-face) + ;; + ;; fontify other preprocessor lines. + '("^#[ \t]*\\(if\\|ifn?def\\)[ \t]+\\([^\n]+\\)" + 2 font-lock-function-name-face t) + ;; + ;; fontify the filename in #include <...> + ;; don't need to do this for #include "..." because those were + ;; already fontified as strings by the syntactic pass. + '("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face) + ;; + ;; fontify the names of functions being defined. + (list (concat + "^\\(" ctoken "[ \t]+\\)?" ; type specs; there can be no + "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? + "\\(" ctoken "[ \t]+\\)?" + "\\(\\*+[ \t]*\\)?" ; pointer + "\\(" ctoken "\\)[ \t]*(") ; name + 5 'font-lock-function-name-face) + ;; + ;; + ;; Fontify structure names (in structure definition form). + (list (concat "^\\(typedef[ \t]+struct\\|struct\\|static[ \t]+struct\\)" + "[ \t]+\\(" ctoken "\\)[ \t]*\\(\{\\|$\\)") + 2 'font-lock-function-name-face) + ;; + ;; Fontify case clauses. This is fast because its anchored on the left. + '("case[ \t]+\\(\\(\\sw\\|\\s_\\)+\\):". 1) + '("\\<\\(default\\):". 1) + )) + + (setq c-font-lock-keywords-2 + (append c-font-lock-keywords-1 + (list + ;; + ;; fontify all storage classes and type specifiers + (cons (concat "\\<\\(" storage "\\)\\>") 'font-lock-type-face) + (cons (concat "\\<\\(" types "\\)\\>") 'font-lock-type-face) + (cons (concat "\\<\\(" prefixes "[ \t]+" types "\\)\\>") + 'font-lock-type-face) + ;; + ;; fontify all builtin tokens + (cons (concat + "[ \t]\\(" + (mapconcat 'identity + '("for" "while" "do" "return" "goto" "case" "break" "switch" + "if" "then" "else if" "else" "return" "default" "continue" + "default" + ) + "\\|") + "\\)[ \t\n(){};,]") + 1) + ;; + ;; fontify case targets and goto-tags. This is slow because the + ;; expression is anchored on the right. + "\\(\\(\\sw\\|\\s_\\)+\\):" + ;; + ;; Fontify variables declared with structures, or typedef names. + '("}[ \t*]*\\(\\(\\sw\\|\\s_\\)+\\)[ \t]*[,;]" + 1 font-lock-function-name-face) + ;; + ;; Fontify global variables without a type. + ; '("^\\([_a-zA-Z0-9:~*]+\\)[ \t]*[[;={]" 1 font-lock-function-name-face) + + ))) + ) + + ; default to the gaudier variety? + ;(defvar c-font-lock-keywords c-font-lock-keywords-2 + ; "Additional expressions to highlight in C mode.") + (defvar c-font-lock-keywords c-font-lock-keywords-1 + "Additional expressions to highlight in C mode.") + + (defvar c++-font-lock-keywords c-font-lock-keywords + "Additional expressions to highlight in C++ mode.") + + + (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" + "#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) + ) + "Additional expressions to highlight in Perl mode.") + + (defvar tex-font-lock-keywords + (list + '("\\(\\\\\\w+\\)" 1 font-lock-keyword-face t) + '("{\\\\em\\([^}]+\\)}" 1 font-lock-comment-face t) + '("{\\\\bf\\([^}]+\\)}" 1 font-lock-keyword-face t) + '("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face t) + '("\\\\\\(begin\\|end\\){\\([a-zA-Z0-9\\*]+\\)}" + 2 font-lock-function-name-face t) + '("[^\\\\]\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) + ; '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) + ) + "Additional expressions to highlight in TeX mode.") + + (defvar texi-font-lock-keywords + (list + "@\\(@\\|[^}\t \n{]+\\)" ;commands + '("^\\(@c\\|@comment\\)[ \t].*$" . font-lock-comment-face) ;comments + '("^\\(*.*\\)[\t ]*$" 1 font-lock-function-name-face t) ;menu items + '("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" 2 font-lock-comment-face t) + '("@\\(file\\|kbd\\|key\\){\\([^}]+\\)" 2 font-lock-string-face t) + '("@\\(samp\\|code\\|var\\){\\([^}]+\\)" 2 font-lock-function-name-face t) + '("@\\(xref\\|pxref\\){\\([^}]+\\)" 2 font-lock-keyword-face t) + '("@end *\\([a-zA-Z0-9]+\\)[ \t]*$" 1 font-lock-function-name-face t) + '("@item \\(.*\\)$" 1 font-lock-function-name-face t) + '("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t) + ) + "Additional expressions to highlight in TeXinfo mode.") + + (provide 'font-lock) + + ;;; font-lock.el ends here diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/forms.el emacs-19.17/lisp/forms.el *** emacs-19.16/lisp/forms.el Sun Jul 4 13:54:46 1993 --- emacs-19.17/lisp/forms.el Sat Jul 17 15:13:23 1993 *************** *** 3,8 **** ;; Author: Johan Vromans ! ;; Version: 1.2.14 ! ;; Keywords: non-text ;; This file is part of GNU Emacs. --- 3,7 ---- ;; Author: Johan Vromans ! ;; Version: 2.0 ;; This file is part of GNU Emacs. *************** *** 34,38 **** ;;; All variables are buffer-local, to enable multiple forms visits ;;; simultaneously. ! ;;; Variable 'forms--mode-setup' is local to *ALL* buffers, for it ;;; controls if forms-mode has been enabled in a buffer. ;;; --- 33,37 ---- ;;; All variables are buffer-local, to enable multiple forms visits ;;; simultaneously. ! ;;; Variable `forms--mode-setup' is local to *ALL* buffers, for it ;;; controls if forms-mode has been enabled in a buffer. ;;; *************** *** 40,47 **** ;;; ;;; Forms mode means visiting a data file which is supposed to consist ! ;;; of records each containing a number of fields. The records are ;;; separated by a newline, the fields are separated by a user-defined ;;; field separater (default: TAB). ! ;;; When shown, a record is transferred to an emacs buffer and ;;; presented using a user-defined form. One record is shown at a ;;; time. --- 39,46 ---- ;;; ;;; Forms mode means visiting a data file which is supposed to consist ! ;;; of records each containing a number of fields. The records are ;;; separated by a newline, the fields are separated by a user-defined ;;; field separater (default: TAB). ! ;;; When shown, a record is transferred to an Emacs buffer and ;;; presented using a user-defined form. One record is shown at a ;;; time. *************** *** 55,94 **** ;;; will be buried, for it is never accessed directly. ;;; ! ;;; Forms mode is invoked using "forms-find-file control-file". ! ;;; Alternativily forms-find-file-other-window can be used. ;;; ;;; You may also visit the control file, and switch to forms mode by hand ;;; with M-x forms-mode . ;;; ! ;;; Automatic mode switching is supported, so you may use "find-file" ! ;;; if you specify "-*- forms -*-" in the first line of the control file. ;;; ! ;;; The control file is visited, evaluated using ! ;;; eval-current-buffer, and should set at least the following ! ;;; variables: ;;; ! ;;; forms-file [string] the name of the data file. ;;; ! ;;; forms-number-of-fields [integer] ;;; The number of fields in each record. ;;; ! ;;; forms-format-list [list] formatting instructions. ;;; ! ;;; The forms-format-list should be a list, each element containing ;;; ! ;;; - a string, e.g. "hello" (which is inserted \"as is\"), ;;; - ;;; - an integer, denoting a field number. The contents of the field - ;;; are inserted at this point. - ;;; The first field has number one. - ;;; - ;;; - a function call, e.g. (insert "text"). This function call is - ;;; dynamically evaluated and should return a string. It should *NOT* - ;;; have side-effects on the forms being constructed. - ;;; The current fields are available to the function in the variable - ;;; forms-fields, they should *NOT* be modified. - ;;; - ;;; - a lisp symbol, that must evaluate to one of the above. - ;;; ;;; Optional variables which may be set in the control file: ;;; --- 54,95 ---- ;;; will be buried, for it is never accessed directly. ;;; ! ;;; Forms mode is invoked using M-x forms-find-file control-file . ! ;;; Alternativily `forms-find-file-other-window' can be used. ;;; ;;; You may also visit the control file, and switch to forms mode by hand ;;; with M-x forms-mode . ;;; ! ;;; Automatic mode switching is supported if you specify ! ;;; "-*- forms -*-" in the first line of the control file. ;;; ! ;;; The control file is visited, evaluated using `eval-current-buffer', ! ;;; and should set at least the following variables: ;;; ! ;;; forms-file [string] ! ;;; The name of the data file. ;;; ! ;;; forms-number-of-fields [integer] ;;; The number of fields in each record. ;;; ! ;;; forms-format-list [list] ! ;;; Formatting instructions. ;;; ! ;;; `forms-format-list' should be a list, each element containing ;;; ! ;;; - a string, e.g. "hello". The string is inserted in the forms ! ;;; "as is". ! ;;; ! ;;; - an integer, denoting a field number. ! ;;; The contents of this field are inserted at this point. ! ;;; Fields are numbered starting with number one. ! ;;; ! ;;; - a function call, e.g. (insert "text"). ! ;;; This function call is dynamically evaluated and should return a ! ;;; string. It should *NOT* have side-effects on the forms being ! ;;; constructed. The current fields are available to the function ! ;;; in the variable `forms-fields', they should *NOT* be modified. ! ;;; ! ;;; - a lisp symbol, that must evaluate to one of the above. ;;; ;;; Optional variables which may be set in the control file: ;;; *************** *** 98,123 **** ;;; ;;; forms-read-only [bool, default nil] ! ;;; 't' means that the data file is visited read-only. ;;; If no write access to the data file is ! ;;; possible, read-only mode is enforced. ;;; ;;; forms-multi-line [string, default "^K"] ;;; If non-null the records of the data file may ! ;;; contain fields which span multiple lines in ;;; the form. ! ;;; This variable denoted the separator character ;;; to be used for this purpose. Upon display, all ;;; occurrencies of this character are translated ;;; to newlines. Upon storage they are translated ! ;;; back to the separator. ;;; ;;; forms-forms-scroll [bool, default t] ! ;;; If non-nil: redefine scroll-up/down to perform ! ;;; forms-next/prev-field if in forms mode. ;;; ;;; forms-forms-jump [bool, default t] ! ;;; If non-nil: redefine beginning/end-of-buffer ! ;;; to performs forms-first/last-field if in ! ;;; forms mode. ;;; ;;; forms-new-record-filter [symbol, no default] --- 99,126 ---- ;;; ;;; forms-read-only [bool, default nil] ! ;;; Non-nil means that the data file is visited ! ;;; read-only (view mode) as opposed to edit mode. ;;; If no write access to the data file is ! ;;; possible, view mode is enforced. ;;; ;;; forms-multi-line [string, default "^K"] ;;; If non-null the records of the data file may ! ;;; contain fields that can span multiple lines in ;;; the form. ! ;;; This variable denotes the separator character ;;; to be used for this purpose. Upon display, all ;;; occurrencies of this character are translated ;;; to newlines. Upon storage they are translated ! ;;; back to the separator character. ;;; ;;; forms-forms-scroll [bool, default t] ! ;;; Non-nil means: rebind locally the commands that ! ;;; perform `scroll-up' or `scroll-down' to use ! ;;; `forms-next-field' resp. `forms-prev-field'. ;;; ;;; forms-forms-jump [bool, default t] ! ;;; Non-nil means: rebind locally the commands that ! ;;; perform `beginning-of-buffer' or `end-of-buffer' ! ;;; to perform `forms-first-field' resp. `forms-last-field'. ;;; ;;; forms-new-record-filter [symbol, no default] *************** *** 138,168 **** ;;; be the function itself. ;;; ;;; After evaluating the control file, its buffer is cleared and used ;;; for further processing. ! ;;; The data file (as designated by "forms-file") is visited in a buffer ! ;;; (forms--file-buffer) which will not normally be shown. ;;; Great malfunctioning may be expected if this file/buffer is modified ! ;;; outside of this package while it's being visited! ;;; ! ;;; A record from the data file is transferred from the data file, ! ;;; split into fields (into forms--the-record-list), and displayed using ! ;;; the specs in forms-format-list. ! ;;; A format routine 'forms--format' is built upon startup to format ! ;;; the records. ;;; ;;; When a form is changed the record is updated as soon as this form ! ;;; is left. The contents of the form are parsed using forms-format-list, ! ;;; and the fields which are deduced from the form are modified. So, ! ;;; fields not shown on the forms retain their origional values. ! ;;; The newly formed record and replaces the contents of the ! ;;; old record in forms--file-buffer. ! ;;; A parse routine 'forms--parser' is built upon startup to parse ;;; the records. ;;; ! ;;; Two exit functions exist: forms-exit (which saves) and forms-exit-no-save ! ;;; (which doesn't). However, if forms-exit-no-save is executed and the file ! ;;; buffer has been modified, emacs will ask questions. ;;; ! ;;; Other functions are: ;;; ;;; paging (forward, backward) by record --- 141,197 ---- ;;; be the function itself. ;;; + ;;; forms-use-text-properties [bool, see text for default] + ;;; This variable controls if forms mode should use + ;;; text properties to protect the form text from being + ;;; modified (using text-property `read-only'). + ;;; Also, the read-write fields are shown using a + ;;; distinct face, if possible. + ;;; This variable defaults to t if running Emacs 19 + ;;; with text properties. + ;;; The default face to show read-write fields is + ;;; copied from face `region'. + ;;; + ;;; forms-ro-face [symbol, default 'default] + ;;; This is the face that is used to show + ;;; read-only text on the screen.If used, this + ;;; variable should be set to a symbol that is a + ;;; valid face. + ;;; E.g. + ;;; (make-face 'my-face) + ;;; (setq forms-ro-face 'my-face) + ;;; + ;;; forms-rw-face [symbol, default 'region] + ;;; This is the face that is used to show + ;;; read-write text on the screen. + ;;; ;;; After evaluating the control file, its buffer is cleared and used ;;; for further processing. ! ;;; The data file (as designated by `forms-file') is visited in a buffer ! ;;; `forms--file-buffer' which will not normally be shown. ;;; Great malfunctioning may be expected if this file/buffer is modified ! ;;; outside of this package while it is being visited! ;;; ! ;;; Normal operation is to transfer one line (record) from the data file, ! ;;; split it into fields (into `forms--the-record-list'), and display it ! ;;; using the specs in `forms-format-list'. ! ;;; A format routine `forms--format' is built upon startup to format ! ;;; the records according to `forms-format-list'. ;;; ;;; When a form is changed the record is updated as soon as this form ! ;;; is left. The contents of the form are parsed using information ! ;;; obtained from `forms-format-list', and the fields which are ! ;;; deduced from the form are modified. Fields not shown on the forms ! ;;; retain their origional values. The newly formed record then ! ;;; replaces the contents of the old record in `forms--file-buffer'. ! ;;; A parse routine `forms--parser' is built upon startup to parse ;;; the records. ;;; ! ;;; Two exit functions exist: `forms-exit' and `forms-exit-no-save'. ! ;;; `forms-exit' saves the data to the file, if modified. ! ;;; `forms-exit-no-save` does not. However, if `forms-exit-no-save' ! ;;; is executed and the file buffer has been modified, Emacs will ask ! ;;; questions anyway. ;;; ! ;;; Other functions provided by forms mode are: ;;; ;;; paging (forward, backward) by record *************** *** 180,186 **** ;;; Commands and keymaps: ;;; ! ;;; A local keymap 'forms-mode-map' is used in the forms buffer. ! ;;; As conventional, this map can be accessed with C-c prefix. ! ;;; In read-only mode, the C-c prefix must be omitted. ;;; ;;; Default bindings: --- 209,216 ---- ;;; Commands and keymaps: ;;; ! ;;; A local keymap `forms-mode-map' is used in the forms buffer. ! ;;; If the forms is in view mode, this keymap is used so all forms mode ! ;;; functions are accessible. ! ;;; If the forms is in edit mode, this map can be accessed with C-c prefix. ;;; ;;; Default bindings: *************** *** 204,229 **** ;;; DEL forms-prev-record ;;; ! ;;; The bindings of standard functions scroll-up, scroll-down, ! ;;; beginning-of-buffer and end-of-buffer are locally replaced with ;;; forms mode functions next/prev record and first/last ! ;;; record. Buffer-local variables forms-forms-scroll and ! ;;; forms-forms-jump (default: t) may be set to nil to inhibit ! ;;; rebinding. ;;; ! ;;; A local-write-file hook is defined to save the actual data file ! ;;; instead of the buffer data, a revert-file-hook is defined to ;;; revert a forms to original. - ;;; - ;;; For convenience, TAB is always bound to forms-next-field, so you - ;;; don't need the C-c prefix for this command. ;;; Code: ! ;;; Global variables and constants (provide 'forms) ;;; official (provide 'forms-mode) ;;; for compatibility ! (defconst forms-version "1.2.14" "Version of forms-mode implementation.") --- 234,258 ---- ;;; DEL forms-prev-record ;;; ! ;;; For convenience, TAB is always bound to `forms-next-field', so you ! ;;; don't need the C-c prefix for this command. ! ;;; ! ;;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump') ! ;;; the bindings of standard functions `scroll-up', `scroll-down', ! ;;; `beginning-of-buffer' and `end-of-buffer' are locally replaced with ;;; forms mode functions next/prev record and first/last ! ;;; record. ;;; ! ;;; `local-write-file hook' is defined to save the actual data file ! ;;; instead of the buffer data, `revert-file-hook' is defined to ;;; revert a forms to original. ;;; Code: ! ;;; Global variables and constants: (provide 'forms) ;;; official (provide 'forms-mode) ;;; for compatibility ! (defconst forms-version "2.0" "Version of forms-mode implementation.") *************** *** 231,235 **** "Hook functions to be run upon entering Forms mode.") ! ;;; Mandatory variables - must be set by evaluating the control file (defvar forms-file nil --- 260,264 ---- "Hook functions to be run upon entering Forms mode.") ! ;;; Mandatory variables - must be set by evaluating the control file. (defvar forms-file nil *************** *** 242,246 **** "Number of fields per record.") ! ;;; Optional variables with default values (defvar forms-field-sep "\t" --- 271,275 ---- "Number of fields per record.") ! ;;; Optional variables with default values. (defvar forms-field-sep "\t" *************** *** 248,255 **** (defvar forms-read-only nil ! "Read-only mode (defaults to the write access on the data file).") (defvar forms-multi-line "\C-k" ! "Character to separate multi-line fields (default C-k).") (defvar forms-forms-scroll t --- 277,285 ---- (defvar forms-read-only nil ! "Non-nil means: visit the file in view (read-only) mode. ! (Defaults to the write access on the data file).") (defvar forms-multi-line "\C-k" ! "If not nil: use this character to separate multi-line fields (default C-k).") (defvar forms-forms-scroll t *************** *** 260,263 **** --- 290,314 ---- "*Non-nil means redefine beginning/end-of-buffer in Forms mode. The replacement commands performs forms-first/last-record.") + + (defvar forms-new-record-filter nil + "The name of a function that is called when a new record is created.") + + (defvar forms-modified-record-filter nil + "The name of a function that is called when a record has been modified.") + + (defvar forms-fields nil + "List with fields of the current forms. First field has number 1. + This variable is for use by the filter routines only. + The contents may NOT be modified.") + + (defvar forms-use-text-properties (fboundp 'set-text-properties) + "*Non-nil means: use emacs-19 text properties. + Defaults to t if this emacs is capable of handling text properties.") + + (defvar forms-ro-face 'default + "The face (a symbol) that is used to display read-only text on the screen.") + + (defvar forms-rw-face 'region + "The face (a symbol) that is used to display read-write text on the screen.") ;;; Internal variables. *************** *** 278,283 **** "Field markers in the screen.") ! (defvar forms--number-of-markers 0 ! "Number of fields on screen.") (defvar forms--the-record-list nil --- 329,334 ---- "Field markers in the screen.") ! (defvar forms--dyntexts nil ! "Dynamic texts (resulting from function calls) on the screen.") (defvar forms--the-record-list nil *************** *** 294,331 **** (defvar forms--mode-setup nil ! "Internal - keeps track of forms-mode being set-up.") (make-variable-buffer-local 'forms--mode-setup) (defvar forms--new-record-filter nil ! "Internal - set if a new record filter has been defined.") (defvar forms--modified-record-filter nil ! "Internal - set if a modified record filter has been defined.") (defvar forms--dynamic-text nil ! "Internal - holds dynamic text to insert between fields.") ! (defvar forms-fields nil ! "List with fields of the current forms. First field has number 1.") ! (defvar forms-new-record-filter nil ! "The name of a function that is called when a new record is created.") ! (defvar forms-modified-record-filter nil ! "The name of a function that is called when a record has been modified.") - ;;; forms-mode - ;;; - ;;; This is not a simple major mode, as usual. Therefore, forms-mode - ;;; takes an optional argument 'primary' which is used for the initial - ;;; set-up. Normal use would leave 'primary' to nil. - ;;; - ;;; A global buffer-local variable 'forms--mode-setup' has the same effect - ;;; but makes it possible to auto-invoke forms-mode using find-file. - ;;; - ;;; Note: although it seems logical to have (make-local-variable) executed - ;;; where the variable is first needed, I deliberately placed all calls - ;;; in the forms-mode function. - ;;;###autoload (defun forms-mode (&optional primary) --- 345,369 ---- (defvar forms--mode-setup nil ! "To keep track of forms-mode being set-up.") (make-variable-buffer-local 'forms--mode-setup) (defvar forms--new-record-filter nil ! "Set if a new record filter has been defined.") (defvar forms--modified-record-filter nil ! "Set if a modified record filter has been defined.") (defvar forms--dynamic-text nil ! "Array that holds dynamic texts to insert between fields.") ! (defvar forms--elements nil ! "Array with the order in which the fields are displayed.") ! (defvar forms--ro-face nil ! "Face used to represent read-only data on the screen.") ! (defvar forms--rw-face nil ! "Face used to represent read-write data on the screen.") ;;;###autoload (defun forms-mode (&optional primary) *************** *** 337,352 **** (interactive) ; no - 'primary' is not prefix arg ;; Primary set-up: evaluate buffer and check if the mandatory ;; variables have been set. (if (or primary (not forms--mode-setup)) (progn (kill-all-local-variables) ! ;; make mandatory variables (make-local-variable 'forms-file) (make-local-variable 'forms-number-of-fields) (make-local-variable 'forms-format-list) ! ;; make optional variables (make-local-variable 'forms-field-sep) (make-local-variable 'forms-read-only) --- 375,401 ---- (interactive) ; no - 'primary' is not prefix arg + ;; This is not a simple major mode, as usual. Therefore, forms-mode + ;; takes an optional argument `primary' which is used for the + ;; initial set-up. Normal use would leave `primary' to nil. + ;; A global buffer-local variable `forms--mode-setup' has the same + ;; effect but makes it possible to auto-invoke forms-mode using + ;; `find-file'. + ;; Note: although it seems logical to have `make-local-variable' + ;; executed where the variable is first needed, I have deliberately + ;; placed all calls in this function. + ;; Primary set-up: evaluate buffer and check if the mandatory ;; variables have been set. (if (or primary (not forms--mode-setup)) (progn + ;;(message "forms: setting up...") (kill-all-local-variables) ! ;; Make mandatory variables. (make-local-variable 'forms-file) (make-local-variable 'forms-number-of-fields) (make-local-variable 'forms-format-list) ! ;; Make optional variables. (make-local-variable 'forms-field-sep) (make-local-variable 'forms-read-only) *************** *** 354,360 **** --- 403,423 ---- (make-local-variable 'forms-forms-scroll) (make-local-variable 'forms-forms-jump) + (make-local-variable 'forms-use-text-properties) + (make-local-variable 'forms--new-record-filter) + (make-local-variable 'forms--modified-record-filter) + + ;; Make sure no filters exist. (fmakunbound 'forms-new-record-filter) + (fmakunbound 'forms-modified-record-filter) + + ;; If running Emacs 19 under X, setup faces to show read-only and + ;; read-write fields. + (if (fboundp 'make-face) + (progn + (make-local-variable 'forms-ro-face) + (make-local-variable 'forms-rw-face))) ;; eval the buffer, should set variables + ;;(message "forms: processing control file...") (eval-current-buffer) *************** *** 374,391 **** (error "'forms-multi-line' is equal to 'forms-field-sep'")) (error "'forms-multi-line' must be nil or a one-character string"))) ! ;; validate and process forms-format-list ! (make-local-variable 'forms--number-of-markers) ! (make-local-variable 'forms--markers) (forms--process-format-list) ! ;; build the formatter and parser (make-local-variable 'forms--format) (forms--make-format) (make-local-variable 'forms--parser) (forms--make-parser) ! ;; check if record filters are defined ! (make-local-variable 'forms--new-record-filter) (setq forms--new-record-filter (cond --- 437,460 ---- (error "'forms-multi-line' is equal to 'forms-field-sep'")) (error "'forms-multi-line' must be nil or a one-character string"))) + (or (fboundp 'set-text-properties) + (setq forms-use-text-properties nil)) ! ;; Validate and process forms-format-list. ! ;;(message "forms: pre-processing format list...") (forms--process-format-list) ! ;; Build the formatter and parser. ! ;;(message "forms: building formatter...") (make-local-variable 'forms--format) + (make-local-variable 'forms--markers) + (make-local-variable 'forms--dyntexts) + (make-local-variable 'forms--elements) + ;;(message "forms: building parser...") (forms--make-format) (make-local-variable 'forms--parser) (forms--make-parser) + ;;(message "forms: building parser... done.") ! ;; Check if record filters are defined. (setq forms--new-record-filter (cond *************** *** 396,400 **** forms-new-record-filter))) (fmakunbound 'forms-new-record-filter) - (make-local-variable 'forms--modified-record-filter) (setq forms--modified-record-filter (cond --- 465,468 ---- *************** *** 406,422 **** (fmakunbound 'forms-modified-record-filter) ! ;; dynamic text support ! (make-local-variable 'forms--dynamic-text) (make-local-variable 'forms-fields) ! ;; prepare this buffer for further processing ! (setq buffer-read-only nil) ! ;; prevent accidental overwrite of the control file and autosave (setq buffer-file-name nil) (auto-save-mode nil) ! ;; and clean it ! (erase-buffer))) ;; Make more local variables. --- 474,505 ---- (fmakunbound 'forms-modified-record-filter) ! ;; The filters acces the contents of the forms using `forms-fields'. (make-local-variable 'forms-fields) ! ;; Dynamic text support. ! (make-local-variable 'forms--dynamic-text) ! ;; Prevent accidental overwrite of the control file and autosave. (setq buffer-file-name nil) (auto-save-mode nil) ! ;; Prepare this buffer for further processing. ! (setq buffer-read-only nil) ! (erase-buffer) ! ! ;;(message "forms: setting up... done.") ! )) ! ! ;; Copy desired faces to the actual variables used by the forms formatter. ! (if (fboundp 'make-face) ! (progn ! (make-local-variable 'forms--ro-face) ! (make-local-variable 'forms--rw-face) ! (if forms-read-only ! (progn ! (setq forms--ro-face forms-ro-face) ! (setq forms--rw-face forms-ro-face)) ! (setq forms--ro-face forms-ro-face) ! (setq forms--rw-face forms-rw-face)))) ;; Make more local variables. *************** *** 425,429 **** (make-local-variable 'forms--current-record) (make-local-variable 'forms--the-record-list) ! (make-local-variable 'forms--search-rexexp) ;; A bug in the current Emacs release prevents a keymap --- 508,512 ---- (make-local-variable 'forms--current-record) (make-local-variable 'forms--the-record-list) ! (make-local-variable 'forms--search-regexp) ;; A bug in the current Emacs release prevents a keymap *************** *** 433,438 **** (if forms-mode-map ; already defined nil (setq forms-mode-map (make-keymap)) ! (forms--mode-commands forms-mode-map)) ;; find the data file --- 516,524 ---- (if forms-mode-map ; already defined nil + ;;(message "forms: building keymap...") (setq forms-mode-map (make-keymap)) ! (forms--mode-commands forms-mode-map) ! ;;(message "forms: building keymap... done.") ! ) ;; find the data file *************** *** 443,462 **** (setq forms--total-records (save-excursion ! (set-buffer forms--file-buffer) ! (bury-buffer (current-buffer)) ! (setq ro buffer-read-only) ! (count-lines (point-min) (point-max)))) (if ro (setq forms-read-only t))) ;; set the major mode indicator (setq major-mode 'forms-mode) (setq mode-name "Forms") (make-local-variable 'minor-mode-alist) ; needed? (forms--set-minor-mode) (forms--set-keymaps) (make-local-variable 'local-write-file-hooks) (forms--change-commands) (set-buffer-modified-p nil) --- 529,558 ---- (setq forms--total-records (save-excursion ! (prog1 ! (progn ! ;;(message "forms: counting records...") ! (set-buffer forms--file-buffer) ! (bury-buffer (current-buffer)) ! (setq ro buffer-read-only) ! (count-lines (point-min) (point-max))) ! ;;(message "forms: counting records... done.") ! ))) (if ro (setq forms-read-only t))) + ;;(message "forms: proceeding setup...") ;; set the major mode indicator (setq major-mode 'forms-mode) (setq mode-name "Forms") (make-local-variable 'minor-mode-alist) ; needed? + ;;(message "forms: proceeding setup (minor mode)...") (forms--set-minor-mode) + ;;(message "forms: proceeding setup (keymaps)...") (forms--set-keymaps) (make-local-variable 'local-write-file-hooks) + ;;(message "forms: proceeding setup (commands)...") (forms--change-commands) + ;;(message "forms: proceeding setup (buffer)...") (set-buffer-modified-p nil) *************** *** 471,475 **** --- 567,573 ---- ;; user customising + ;;(message "forms: proceeding setup (user hooks)...") (run-hooks 'forms-mode-hooks) + ;;(message "forms: setting up... done.") ;; be helpful *************** *** 479,504 **** (setq forms--mode-setup t)) - ;;; forms-process-format-list - ;;; - ;;; Validates forms-format-list. - ;;; Sets forms--number-of-markers and forms--markers. - (defun forms--process-format-list () ! "Validate forms-format-list and set some global variables." ! (forms--debug "forms-forms-list before 1st pass:\n" ! 'forms-format-list) ! ! ;; it must be non-nil (or forms-format-list (error "'forms-format-list' has not been set")) ! ;; it must be a list ... (or (listp forms-format-list) (error "'forms-format-list' is not a list")) ! (setq forms--number-of-markers 0) (let ((the-list forms-format-list) ; the list of format elements (this-item 0) ; element in list (field-num 0)) ; highest field number --- 577,606 ---- (setq forms--mode-setup t)) (defun forms--process-format-list () ! ;; Validate `forms-format-list' and set some global variables. ! ;; Symbols in the list are evaluated, and consecutive strings are ! ;; concatenated. ! ;; Array `forms--elements' is constructed that contains the order ! ;; of the fields on the display. This array is used by ! ;; `forms--parser-using-text-properties' to extract the fields data ! ;; from the form on the screen. ! ;; Upon completion, `forms-format-list' is garanteed correct, so ! ;; `forms--make-format' and `forms--make-parser' do not need to perform ! ;; any checks. ! ;; Verify that `forms-format-list' is not nil. (or forms-format-list (error "'forms-format-list' has not been set")) ! ;; It must be a list. (or (listp forms-format-list) (error "'forms-format-list' is not a list")) ! ;; Assume every field is painted once. ! ;; `forms--elements' will grow if needed. ! (setq forms--elements (make-vector forms-number-of-fields nil)) (let ((the-list forms-format-list) ; the list of format elements (this-item 0) ; element in list + (prev-item nil) (field-num 0)) ; highest field number *************** *** 510,514 **** (rem (cdr-safe the-list))) ! ;; if it is a symbol, eval it first (if (and (symbolp el) (boundp el)) --- 612,616 ---- (rem (cdr-safe the-list))) ! ;; If it is a symbol, eval it first. (if (and (symbolp el) (boundp el)) *************** *** 517,526 **** (cond ! ;; try string ... ! ((stringp el)) ; string is OK ! ! ;; try numeric ... ((numberp el) (if (or (<= el 0) (> el forms-number-of-fields)) --- 619,635 ---- (cond ! ;; Try string ... ! ((stringp el) ! (if (stringp prev-item) ; try to concatenate strings ! (setq prev-item (concat prev-item el)) ! (if prev-item ! (setq forms-format-list ! (append forms-format-list (list prev-item) nil))) ! (setq prev-item el))) ! ! ;; Try numeric ... ((numberp el) + ;; Validate range. (if (or (<= el 0) (> el forms-number-of-fields)) *************** *** 529,604 **** el forms-number-of-fields)) ! (setq forms--number-of-markers (1+ forms--number-of-markers)) ! (if (> el field-num) ! (setq field-num el))) ! ;; try function ((listp el) (or (fboundp (car-safe el)) (error "Forms error: not a function: %s" ! (prin1-to-string (car-safe el))))) ;; else (t ! (error "Invalid element in 'forms-format-list': %s" (prin1-to-string el)))) ! ;; advance to next element of the list ! (setq the-list rem) ! (setq forms-format-list ! (append forms-format-list (list el) nil))))) ! ! (forms--debug "forms-forms-list after 1st pass:\n" ! 'forms-format-list) ! ! ;; concat adjacent strings ! (setq forms-format-list (forms--concat-adjacent forms-format-list)) ! ! (forms--debug "forms-forms-list after 2nd pass:\n" ! 'forms-format-list ! 'forms--number-of-markers) ! (setq forms--markers (make-vector forms--number-of-markers nil))) ! ;;; Build the format routine from forms-format-list. ! ;;; ! ;;; The format routine (forms--format) will look like ! ;;; ! ;;; (lambda (arg) ! ;;; (setq forms--dynamic-text nil) ! ;;; ;; "text: " ! ;;; (insert "text: ") ! ;;; ;; 6 ! ;;; (aset forms--markers 0 (point-marker)) ! ;;; (insert (elt arg 5)) ! ;;; ;; "\nmore text: " ! ;;; (insert "\nmore text: ") ! ;;; ;; (tocol 40) ! ;;; (let ((the-dyntext (tocol 40))) ! ;;; (insert the-dyntext) ! ;;; (setq forms--dynamic-text (append forms--dynamic-text ! ;;; (list the-dyntext)))) ! ;;; ;; 9 ! ;;; (aset forms--markers 1 (point-marker)) ! ;;; (insert (elt arg 8)) ! ;;; ! ;;; ... ) ! ;;; (defun forms--make-format () ! "Generate format function for forms." ! (setq forms--format (forms--format-maker forms-format-list)) (forms--debug 'forms--format)) ! (defun forms--format-maker (the-format-list) ! "Returns the parser function for forms." ! (let ((the-marker 0)) ! (` (lambda (arg) ! (setq forms--dynamic-text nil) ! (,@ (apply 'append ! (mapcar 'forms--make-format-elt the-format-list))))))) (defun forms--make-format-elt (el) (cond ((stringp el) --- 638,910 ---- el forms-number-of-fields)) ! ;; Store forms order. ! (if (> field-num (length forms--elements)) ! (setq forms--elements (vconcat forms--elements (1- el))) ! (aset forms--elements field-num (1- el))) ! (setq field-num (1+ field-num)) ! ! ;; Make sure the field is preceded by something. ! (if prev-item ! (setq forms-format-list ! (append forms-format-list (list prev-item) nil)) ! (setq forms-format-list ! (append forms-format-list (list "\n") nil))) ! (setq prev-item el)) ! ;; Try function ... ((listp el) + + ;; Validate. (or (fboundp (car-safe el)) (error "Forms error: not a function: %s" ! (prin1-to-string (car-safe el)))) + ;; Shift. + (if prev-item + (setq forms-format-list + (append forms-format-list (list prev-item) nil))) + (setq prev-item el)) + ;; else (t ! (error "Forms error: invalid element %s" (prin1-to-string el)))) ! ;; Advance to next element of the list. ! (setq the-list rem))) ! ! ;; Append last item. ! (if prev-item ! (progn ! (setq forms-format-list ! (append forms-format-list (list prev-item) nil)) ! ;; Append a newline if the last item is a field. ! ;; This prevents pasrsing problems. ! ;; Also it makes it possible to insert an empty last field. ! (if (numberp prev-item) ! (setq forms-format-list ! (append forms-format-list (list "\n") nil)))))) ! ! (forms--debug 'forms-format-list ! 'forms--elements)) ! ! ;; Special treatment for read-only segments. ! ;; ! ;; If text is inserted after a read-only segment, it inherits the ! ;; read-only properties. This is not what we want. ! ;; The modification hook of the last character of the read-only segment ! ;; temporarily switches its properties to read-write, so the new ! ;; text gets the right properties. ! ;; The post-command-hook is used to restore the original properties. ! ;; ! ;; A character category `forms-electric' is used for the characters ! ;; that get the modification hook set. Using a category, it is ! ;; possible to globally enable/disable the modification hook. This is ! ;; necessary, since modifying a hook or setting text properties are ! ;; considered modifications and would trigger the hooks while building ! ;; the forms. ! ! (defvar forms--ro-modification-start nil ! "Record start of modification command.") ! (defvar forms--ro-properties nil ! "Original properties of the character being overridden.") ! ! (defun forms--romh (begin end) ! "`modification-hook' function for forms-electric characters." ! ! ;; Note start location. ! (or forms--ro-modification-start ! (setq forms--ro-modification-start (point))) ! ! ;; Fetch current properties. ! (setq forms--ro-properties ! (text-properties-at (1- forms--ro-modification-start))) ! ! ;; Disarm modification hook. ! (setplist 'forms--electric nil) ! ! ;; Replace them. ! (let ((inhibit-read-only t)) ! (set-text-properties ! (1- forms--ro-modification-start) forms--ro-modification-start ! (list 'face forms--rw-face))) ! ! ;; Re-arm electric. ! (setplist 'forms--electric '(modification-hooks (forms--romh))) ! ! ;; Enable `post-command-hook' to restore the properties. ! (setq post-command-hook ! (append (list 'forms--romh-post-command-hook) post-command-hook))) ! ! (defun forms--romh-post-command-hook () ! "`post-command-hook' function for forms--electric characters." ! ! ;; Disable `post-command-hook'. ! (setq post-command-hook ! (delq 'forms--romh-post-command-hook post-command-hook)) ! ! ;; Disarm modification hook. ! (setplist 'forms--electric nil) ! ! ;; Restore properties. ! (if forms--ro-modification-start ! (let ((inhibit-read-only t)) ! (set-text-properties ! (1- forms--ro-modification-start) forms--ro-modification-start ! forms--ro-properties))) ! ! ;; Re-arm electric. ! (setplist 'forms--electric '(modification-hooks (forms--romh))) ! ;; Cleanup. ! (setq forms--ro-modification-start nil)) ! (defvar forms--marker) ! (defvar forms--dyntext) (defun forms--make-format () ! "Generate `forms--format' using the information in `forms-format-list'." ! ! ;; The real work is done using a mapcar of `forms--make-format-elt' on ! ;; `forms-format-list'. ! ;; This function sets up the necessary environment, and decides ! ;; which function to mapcar. ! ! (let ((forms--marker 0) ! (forms--dyntext 0)) ! (setq ! forms--format ! (if forms-use-text-properties ! (` (lambda (arg) ! (let ((inhibit-read-only t)) ! (setplist 'forms--electric nil) ! (,@ (apply 'append ! (mapcar 'forms--make-format-elt-using-text-properties ! forms-format-list)))) ! (setplist 'forms--electric ! '(modification-hooks (forms--romh))) ! (setq forms--ro-modification-start nil))) ! (` (lambda (arg) ! (,@ (apply 'append ! (mapcar 'forms--make-format-elt forms-format-list))))))) ! ! ;; We have tallied the number of markers and dynamic texts, ! ;; so we can allocate the arrays now. ! (setq forms--markers (make-vector forms--marker nil)) ! (setq forms--dyntexts (make-vector forms--dyntext nil))) (forms--debug 'forms--format)) ! (defun forms--make-format-elt-using-text-properties (el) ! "Helper routine to generate format function." ! ! ;; The format routine `forms--format' will look like ! ;; ! ;; ;; preamble ! ;; (lambda (arg) ! ;; (let ((inhibit-read-only t)) ! ;; (setplist 'forms--electric nil) ! ;; ! ;; ;; a string, e.g. "text: " ! ;; (set-text-properties ! ;; (point) ! ;; (progn (insert "text: ") (point)) ! ;; (list 'face forms--ro-face 'read-only 1)) ! ;; ! ;; ;; a field, e.g. 6 ! ;; (let ((here (point))) ! ;; (aset forms--markers 0 (point-marker)) ! ;; (insert (elt arg 5)) ! ;; (or (= (point) here) ! ;; (set-text-properties ! ;; here (point) ! ;; (list 'face forms--rw-face))) ! ;; (if (get-text-property (1- here) 'read-only) ! ;; (put-text-property ! ;; (1- here) here ! ;; 'category 'forms--electric))) ! ;; ! ;; ;; another string, e.g. "\nmore text: " ! ;; (set-text-properties ! ;; (point) ! ;; (progn (insert "\nmore text: ") (point)) ! ;; (list 'face forms--ro-face ! ;; 'read-only 2)) ! ;; ! ;; ;; a function, e.g. (tocol 40) ! ;; (set-text-properties ! ;; (point) ! ;; (progn ! ;; (insert (aset forms--dyntexts 0 (tocol 40))) ! ;; (point)) ! ;; (list 'face forms--ro-face ! ;; 'read-only 2)) ! ;; ! ;; ;; wrap up ! ;; (setplist 'forms--electric ! ;; '(modification-hooks (forms--romh))) ! ;; (setq forms--ro-modification-start nil) ! ;; )) ! ! (cond ! ((stringp el) ! ! (` ((set-text-properties ! (point) ; start at point ! (progn ; until after insertion ! (insert (, el)) ! (point)) ! (list 'face forms--ro-face ; read-only appearance ! 'read-only (,@ (list (1+ forms--marker)))))))) ! ((numberp el) ! (` ((let ((here (point))) ! (aset forms--markers ! (, (prog1 forms--marker ! (setq forms--marker (1+ forms--marker)))) ! (point-marker)) ! (insert (elt arg (, (1- el)))) ! (or (= (point) here) ! (set-text-properties ! here (point) ! (list 'face forms--rw-face))) ! (if (get-text-property (1- here) 'read-only) ! (put-text-property ! (1- here) here ! 'category 'forms--electric)))))) ! ! ((listp el) ! (` ((set-text-properties ! (point) ! (progn ! (insert (aset forms--dyntexts ! (, (prog1 forms--dyntext ! (setq forms--dyntext (1+ forms--dyntext)))) ! (, el))) ! (point)) ! (list 'face forms--ro-face ! 'read-only ! (,@ (list (1+ forms--marker)))))))) ! ! ;; end of cond ! )) (defun forms--make-format-elt (el) + "Helper routine to generate format function." + + ;; If we're not using text properties, the format routine + ;; `forms--format' will look like + ;; + ;; (lambda (arg) + ;; ;; a string, e.g. "text: " + ;; (insert "text: ") + ;; ;; a field, e.g. 6 + ;; (aset forms--markers 0 (point-marker)) + ;; (insert (elt arg 5)) + ;; ;; another string, e.g. "\nmore text: " + ;; (insert "\nmore text: ") + ;; ;; a function, e.g. (tocol 40) + ;; (insert (aset forms--dyntexts 0 (tocol 40))) + ;; ... ) + (cond ((stringp el) *************** *** 606,691 **** ((numberp el) (prog1 ! (` ((aset forms--markers (, the-marker) (point-marker)) (insert (elt arg (, (1- el)))))) ! (setq the-marker (1+ the-marker)))) ((listp el) (prog1 ! (` ((let ((the-dyntext (, el))) ! (insert the-dyntext) ! (setq forms--dynamic-text (append forms--dynamic-text ! (list the-dyntext))))) ! ))))) ! ! (defun forms--concat-adjacent (the-list) ! "Concatenate adjacent strings in the-list and return the resulting list." ! (if (consp the-list) ! (let ((the-rest (forms--concat-adjacent (cdr the-list)))) ! (if (and (stringp (car the-list)) (stringp (car the-rest))) ! (cons (concat (car the-list) (car the-rest)) ! (cdr the-rest)) ! (cons (car the-list) the-rest))) ! the-list)) ! ;;; forms--make-parser. ! ;;; ! ;;; Generate parse routine from forms-format-list. ! ;;; ! ;;; The parse routine (forms--parser) will look like (give or take ! ;;; a few " " . ! ;;; ! ;;; (lambda nil ! ;;; (let (here) ! ;;; (goto-char (point-min)) ! ;;; ! ;;; ;; "text: " ! ;;; (if (not (looking-at "text: ")) ! ;;; (error "Parse error: cannot find \"text: \"")) ! ;;; (forward-char 6) ; past "text: " ! ;;; ! ;;; ;; 6 ! ;;; ;; "\nmore text: " ! ;;; (setq here (point)) ! ;;; (if (not (search-forward "\nmore text: " nil t nil)) ! ;;; (error "Parse error: cannot find \"\\nmore text: \"")) ! ;;; (aset the-recordv 5 (buffer-substring here (- (point) 12))) ! ;;; ! ;;; ;; (tocol 40) ! ;;; (let ((the-dyntext (car-safe forms--dynamic-text))) ! ;;; (if (not (looking-at (regexp-quote the-dyntext))) ! ;;; (error "Parse error: not looking at \"%s\"" the-dyntext)) ! ;;; (forward-char (length the-dyntext)) ! ;;; (setq forms--dynamic-text (cdr-safe forms--dynamic-text))) ! ;;; ... ! ;;; ;; final flush (due to terminator sentinel, see below) ! ;;; (aset the-recordv 7 (buffer-substring (point) (point-max))) ! ;;; (defun forms--make-parser () ! "Generate parser function for forms." ! (setq forms--parser (forms--parser-maker forms-format-list)) (forms--debug 'forms--parser)) ! (defun forms--parser-maker (the-format-list) ! "Returns the parser function for forms." ! (let ((the-field nil) ! (seen-text nil) ! the--format-list) ! ;; add a terminator sentinel ! (setq the--format-list (append the-format-list (list nil))) ! (` (lambda nil ! (let (here) ! (goto-char (point-min)) ! (,@ (apply 'append ! (mapcar 'forms--make-parser-elt the--format-list)))))))) (defun forms--make-parser-elt (el) (cond ((stringp el) (prog1 ! (if the-field (` ((setq here (point)) (if (not (search-forward (, el) nil t nil)) (error "Parse error: cannot find \"%s\"" (, el))) ! (aset the-recordv (, (1- the-field)) (buffer-substring here (- (point) (, (length el))))))) --- 912,1014 ---- ((numberp el) (prog1 ! (` ((aset forms--markers (, forms--marker) (point-marker)) (insert (elt arg (, (1- el)))))) ! (setq forms--marker (1+ forms--marker)))) ((listp el) (prog1 ! (` ((insert (aset forms--dyntexts (, forms--dyntext) (, el))))) ! (setq forms--dyntext (1+ forms--dyntext)))))) ! (defvar forms--field) ! (defvar forms--recordv) ! (defvar forms--seen-text) (defun forms--make-parser () ! "Generate `forms--parser' from the information in `forms-format-list'." ! ! ;; If we can use text properties, we simply set it to ! ;; `forms--parser-using-text-properties'. ! ;; Otherwise, the function is constructed using a mapcar of ! ;; `forms--make-parser-elt on `forms-format-list'. ! ! (setq ! forms--parser ! (if forms-use-text-properties ! (function forms--parser-using-text-properties) ! (let ((forms--field nil) ! (forms--seen-text nil) ! (forms--dyntext 0)) ! ! ;; Note: we add a nil element to the list passed to `mapcar', ! ;; see `forms--make-parser-elt' for details. ! (` (lambda nil ! (let (here) ! (goto-char (point-min)) ! (,@ (apply 'append ! (mapcar ! 'forms--make-parser-elt ! (append forms-format-list (list nil))))))))))) ! (forms--debug 'forms--parser)) ! (defun forms--parser-using-text-properties () ! "Extract field info from forms when using text properties." ! ! ;; Using text properties, we can simply jump to the markers, and ! ;; extract the information up to the following read-only segment. ! ! (let ((i 0) ! here there) ! (while (< i (length forms--markers)) ! (goto-char (setq here (aref forms--markers i))) ! (if (get-text-property here 'read-only) ! (aset forms--recordv (aref forms--elements i) nil) ! (if (setq there ! (next-single-property-change here 'read-only)) ! (aset forms--recordv (aref forms--elements i) ! (buffer-substring here there)) ! (aset forms--recordv (aref forms--elements i) ! (buffer-substring here (point-max))))) ! (setq i (1+ i))))) (defun forms--make-parser-elt (el) + "Helper routine to generate forms parser function." + + ;; The parse routine will look like: + ;; + ;; (lambda nil + ;; (let (here) + ;; (goto-char (point-min)) + ;; + ;; ;; "text: " + ;; (if (not (looking-at "text: ")) + ;; (error "Parse error: cannot find \"text: \"")) + ;; (forward-char 6) ; past "text: " + ;; + ;; ;; 6 + ;; ;; "\nmore text: " + ;; (setq here (point)) + ;; (if (not (search-forward "\nmore text: " nil t nil)) + ;; (error "Parse error: cannot find \"\\nmore text: \"")) + ;; (aset forms--recordv 5 (buffer-substring here (- (point) 12))) + ;; + ;; ;; (tocol 40) + ;; (let ((forms--dyntext (car-safe forms--dynamic-text))) + ;; (if (not (looking-at (regexp-quote forms--dyntext))) + ;; (error "Parse error: not looking at \"%s\"" forms--dyntext)) + ;; (forward-char (length forms--dyntext)) + ;; (setq forms--dynamic-text (cdr-safe forms--dynamic-text))) + ;; ... + ;; ;; final flush (due to terminator sentinel, see below) + ;; (aset forms--recordv 7 (buffer-substring (point) (point-max))) + (cond ((stringp el) (prog1 ! (if forms--field (` ((setq here (point)) (if (not (search-forward (, el) nil t nil)) (error "Parse error: cannot find \"%s\"" (, el))) ! (aset forms--recordv (, (1- forms--field)) (buffer-substring here (- (point) (, (length el))))))) *************** *** 693,726 **** (error "Parse error: not looking at \"%s\"" (, el))) (forward-char (, (length el)))))) ! (setq seen-text t) ! (setq the-field nil))) ((numberp el) ! (if the-field (error "Cannot parse adjacent fields %d and %d" ! the-field el) ! (setq the-field el) nil)) ((null el) ! (if the-field ! (` ((aset the-recordv (, (1- the-field)) (buffer-substring (point) (point-max))))))) ((listp el) (prog1 ! (if the-field (` ((let ((here (point)) ! (the-dyntext (car-safe forms--dynamic-text))) ! (if (not (search-forward the-dyntext nil t nil)) ! (error "Parse error: cannot find \"%s\"" the-dyntext)) ! (aset the-recordv (, (1- the-field)) (buffer-substring here ! (- (point) (length the-dyntext)))) ! (setq forms--dynamic-text (cdr-safe forms--dynamic-text))))) ! (` ((let ((the-dyntext (car-safe forms--dynamic-text))) ! (if (not (looking-at (regexp-quote the-dyntext))) ! (error "Parse error: not looking at \"%s\"" the-dyntext)) ! (forward-char (length the-dyntext)) ! (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))))) ! (setq seen-text t) ! (setq the-field nil))) )) --- 1016,1048 ---- (error "Parse error: not looking at \"%s\"" (, el))) (forward-char (, (length el)))))) ! (setq forms--seen-text t) ! (setq forms--field nil))) ((numberp el) ! (if forms--field (error "Cannot parse adjacent fields %d and %d" ! forms--field el) ! (setq forms--field el) nil)) ((null el) ! (if forms--field ! (` ((aset forms--recordv (, (1- forms--field)) (buffer-substring (point) (point-max))))))) ((listp el) (prog1 ! (if forms--field (` ((let ((here (point)) ! (forms--dyntext (aref forms--dyntexts (, forms--dyntext)))) ! (if (not (search-forward forms--dyntext nil t nil)) ! (error "Parse error: cannot find \"%s\"" forms--dyntext)) ! (aset forms--recordv (, (1- forms--field)) (buffer-substring here ! (- (point) (length forms--dyntext))))))) ! (` ((let ((forms--dyntext (aref forms--dyntexts (, forms--dyntext)))) ! (if (not (looking-at (regexp-quote forms--dyntext))) ! (error "Parse error: not looking at \"%s\"" forms--dyntext)) ! (forward-char (length forms--dyntext)))))) ! (setq forms--dyntext (1+ forms--dyntext)) ! (setq forms--seen-text t) ! (setq forms--field nil))) )) *************** *** 742,745 **** --- 1064,1068 ---- (defun forms--mode-commands (map) "Fill map with all Forms mode commands." + (define-key map "\t" 'forms-next-field) (define-key map " " 'forms-next-record) *************** *** 758,766 **** (define-key map "?" 'describe-mode) (define-key map "\177" 'forms-prev-record) ! ; (define-key map "\C-c" map) ! (define-key map "\e" 'ESC-prefix) ! (define-key map "\C-x" ctl-x-map) ! (define-key map "\C-u" 'universal-argument) ! (define-key map "\C-h" help-map) ) --- 1081,1089 ---- (define-key map "?" 'describe-mode) (define-key map "\177" 'forms-prev-record) ! ;(define-key map "\C-c" map) ! ;(define-key map "\e" 'ESC-prefix) ! ;(define-key map "\C-x" ctl-x-map) ! ;(define-key map "\C-u" 'universal-argument) ! ;(define-key map "\C-h" help-map) ) *************** *** 769,773 **** (defun forms--change-commands () "Localize some commands for Forms mode." ! ;; ;; scroll-down -> forms-prev-record ;; scroll-up -> forms-next-record --- 1092,1096 ---- (defun forms--change-commands () "Localize some commands for Forms mode." ! ;; scroll-down -> forms-prev-record ;; scroll-up -> forms-next-record *************** *** 829,832 **** --- 1152,1157 ---- (defun forms--exit (query &optional save) + "Internal exit from forms mode function." + (let ((buf (buffer-name forms--file-buffer))) (forms--checkmod) *************** *** 850,856 **** (defun forms--get-record () "Fetch the current record from the file buffer." ! ;; ! ;; This function is executed in the context of the forms--file-buffer. ! ;; (or (bolp) (beginning-of-line nil)) --- 1175,1181 ---- (defun forms--get-record () "Fetch the current record from the file buffer." ! ! ;; This function is executed in the context of the `forms--file-buffer'. ! (or (bolp) (beginning-of-line nil)) *************** *** 864,868 **** "Format THE-RECORD and display it in the current buffer." ! ;; split the-record (let (the-result (start-pos 0) --- 1189,1193 ---- "Format THE-RECORD and display it in the current buffer." ! ;; Split the-record. (let (the-result (start-pos 0) *************** *** 871,875 **** (if forms-multi-line (forms--trans the-record forms-multi-line "\n")) ! ;; add an extra separator (makes splitting easy) (setq the-record (concat the-record forms-field-sep)) (while (setq found-pos (string-match forms-field-sep the-record start-pos)) --- 1196,1200 ---- (if forms-multi-line (forms--trans the-record forms-multi-line "\n")) ! ;; Add an extra separator (makes splitting easy). (setq the-record (concat the-record forms-field-sep)) (while (setq found-pos (string-match forms-field-sep the-record start-pos)) *************** *** 881,887 **** (setq buffer-read-only nil) (erase-buffer) ! ;; verify the number of fields, extend forms--the-record-list if needed (if (= (length forms--the-record-list) forms-number-of-fields) nil --- 1206,1216 ---- (setq buffer-read-only nil) + (if forms-use-text-properties + (let ((inhibit-read-only t)) + (setplist 'forms--electric nil) + (set-text-properties (point-min) (point-max) nil))) (erase-buffer) ! ;; Verify the number of fields, extend forms--the-record-list if needed. (if (= (length forms--the-record-list) forms-number-of-fields) nil *************** *** 897,905 **** ""))))) ! ;; call the formatter function (setq forms-fields (append (list nil) forms--the-record-list nil)) (funcall forms--format forms--the-record-list) ! ;; prepare (goto-char (point-min)) (set-buffer-modified-p nil) --- 1226,1234 ---- ""))))) ! ;; Call the formatter function. (setq forms-fields (append (list nil) forms--the-record-list nil)) (funcall forms--format forms--the-record-list) ! ;; Prepare. (goto-char (point-min)) (set-buffer-modified-p nil) *************** *** 917,926 **** ;; Finally, the vector is transformed into a list for further processing. ! (let (the-recordv) ! ;; build the vector ! (setq the-recordv (vconcat forms--the-record-list)) ! ;; parse the form and update the vector (let ((forms--dynamic-text forms--dynamic-text)) (funcall forms--parser)) --- 1246,1255 ---- ;; Finally, the vector is transformed into a list for further processing. ! (let (forms--recordv) ! ;; Build the vector. ! (setq forms--recordv (vconcat forms--the-record-list)) ! ;; Parse the form and update the vector. (let ((forms--dynamic-text forms--dynamic-text)) (funcall forms--parser)) *************** *** 929,942 **** ;; As a service to the user, we add a zeroth element so she ;; can use the same indices as in the forms definition. ! (let ((the-fields (vconcat [nil] the-recordv))) (setq the-fields (funcall forms--modified-record-filter the-fields)) (cdr (append the-fields nil))) ! ;; transform to a list and return ! (append the-recordv nil)))) (defun forms--update () "Update current record with contents of form. ! As a side effect: sets forms--the-record-list ." (if forms-read-only --- 1258,1271 ---- ;; As a service to the user, we add a zeroth element so she ;; can use the same indices as in the forms definition. ! (let ((the-fields (vconcat [nil] forms--recordv))) (setq the-fields (funcall forms--modified-record-filter the-fields)) (cdr (append the-fields nil))) ! ;; Transform to a list and return. ! (append forms--recordv nil)))) (defun forms--update () "Update current record with contents of form. ! As a side effect: sets `forms--the-record-list'." (if forms-read-only *************** *** 946,959 **** (let (the-record) ! ;; build new record (setq forms--the-record-list (forms--parse-form)) (setq the-record (mapconcat 'identity forms--the-record-list forms-field-sep)) ! ;; handle multi-line fields, if allowed (if forms-multi-line (forms--trans the-record "\n" forms-multi-line)) ! ;; a final sanity check before updating (if (string-match "\n" the-record) (progn --- 1275,1288 ---- (let (the-record) ! ;; Build new record. (setq forms--the-record-list (forms--parse-form)) (setq the-record (mapconcat 'identity forms--the-record-list forms-field-sep)) ! ;; Handle multi-line fields, if allowed. (if forms-multi-line (forms--trans the-record "\n" forms-multi-line)) ! ;; A final sanity check before updating. (if (string-match "\n" the-record) (progn *************** *** 1022,1031 **** (interactive "NRecord number: ") ! ;; verify that the record number is within range (if (or (> arg forms--total-records) (<= arg 0)) (progn (beep) ! ;; don't give the message if just paging (if (not relative) (message "Record number %d out of range 1..%d" --- 1351,1360 ---- (interactive "NRecord number: ") ! ;; Verify that the record number is within range. (if (or (> arg forms--total-records) (<= arg 0)) (progn (beep) ! ;; Don't give the message if just paging. (if (not relative) (message "Record number %d out of range 1..%d" *************** *** 1033,1047 **** ) ! ;; flush (forms--checkmod) ! ;; calculate displacement (let ((disp (- arg forms--current-record)) (cur forms--current-record)) ! ;; forms--show-record needs it now (setq forms--current-record arg) ! ;; get the record and show it (forms--show-record (save-excursion --- 1362,1376 ---- ) ! ;; Flush. (forms--checkmod) ! ;; Calculate displacement. (let ((disp (- arg forms--current-record)) (cur forms--current-record)) ! ;; `forms--show-record' needs it now. (setq forms--current-record arg) ! ;; Get the record and show it. (forms--show-record (save-excursion *************** *** 1049,1053 **** (beginning-of-line) ! ;; move, and adjust the amount if needed (shouldn't happen) (if relative (if (zerop disp) --- 1378,1382 ---- (beginning-of-line) ! ;; Move, and adjust the amount if needed (shouldn't happen). (if relative (if (zerop disp) *************** *** 1058,1062 **** (forms--get-record))) ! ;; this shouldn't happen (if (/= forms--current-record cur) (progn --- 1387,1391 ---- (forms--get-record))) ! ;; This shouldn't happen. (if (/= forms--current-record cur) (progn *************** *** 1124,1129 **** "Create a new record before the current one. With ARG: store the record after the current one. ! If a function forms-new-record-filter is defined, or ! forms-new-record-filter contains the name of a function, it is called to fill (some of) the fields with default values." ; The above doc is not true, but for documentary purposes only --- 1453,1458 ---- "Create a new record before the current one. With ARG: store the record after the current one. ! If a function `forms-new-record-filter' is defined, or ! `forms-new-record-filter' contains the name of a function, it is called to fill (some of) the fields with default values." ; The above doc is not true, but for documentary purposes only *************** *** 1233,1237 **** (if (catch 'done ! (while (< i forms--number-of-markers) (if (or (null (setq there (aref forms--markers i))) (<= there here)) --- 1562,1566 ---- (if (catch 'done ! (while (< i (length forms--markers)) (if (or (null (setq there (aref forms--markers i))) (<= there here)) *************** *** 1289,1292 **** --- 1618,1623 ---- (save-excursion (set-buffer (get-buffer-create "*forms-mode debug*")) + (if (zerop (buffer-size)) + (emacs-lisp-mode)) (goto-char (point-max)) (insert ret))))) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/gnus.el emacs-19.17/lisp/gnus.el *** emacs-19.16/lisp/gnus.el Tue Jun 29 19:03:34 1993 --- emacs-19.17/lisp/gnus.el Sat Jul 17 14:56:18 1993 *************** *** 1,5 **** ;;; GNUS: an NNTP-based News Reader for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1993 Free Software Foundation, Inc. ! ;; $Header: /gd/gnu/emacs/19.0/lisp/RCS/gnus.el,v 1.22 1993/06/29 23:03:21 jimb Exp $ ;; This file is part of GNU Emacs. --- 1,5 ---- ;;; 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. *************** *** 613,618 **** (gnus-summary-mode "(gnus)Summary Commands") (gnus-article-mode "(gnus)Article Commands") ! (gnus-kill-file-mode "(gnus)KILL File") ! (gnus-browse-killed-mode "(gnus)Maintenance")) "Assoc list of major modes and related Info nodes.") --- 613,618 ---- (gnus-summary-mode "(gnus)Summary Commands") (gnus-article-mode "(gnus)Article Commands") ! (gnus-kill-file-mode "(gnus)Kill File") ! (gnus-browse-killed-mode "(gnus)Maintaining Subscriptions")) "Assoc list of major modes and related Info nodes.") diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/gud.el emacs-19.17/lisp/gud.el *** emacs-19.16/lisp/gud.el Wed Jun 30 02:21:40 1993 --- emacs-19.17/lisp/gud.el Wed Jul 14 21:48:47 1993 *************** *** 58,62 **** gud-overload-alist)) ! (defun gud-debugger-startup (file args) (error "GUD not properly entered.")) --- 58,62 ---- gud-overload-alist)) ! (defun gud-massage-args (file args) (error "GUD not properly entered.")) *************** *** 129,138 **** ;; ;; comint-prompt-regexp ! ;; gud--debugger-startup ;; gud--marker-filter ;; gud--find-file ;; ! ;; The job of the startup-command method is to fire up a copy of the debugger, ! ;; given a list of debugger arguments. ;; ;; The job of the marker-filter method is to detect file/line markers in --- 129,138 ---- ;; ;; comint-prompt-regexp ! ;; gud--massage-args ;; gud--marker-filter ;; gud--find-file ;; ! ;; The job of the massage-args method is to modify the given list of ! ;; debugger arguments before running the debugger. ;; ;; The job of the marker-filter method is to detect file/line markers in *************** *** 153,158 **** (defvar gud-gdb-history nil) ! (defun gud-gdb-debugger-startup (file args) ! (apply 'make-comint (concat "gud-" file) "gdb" nil "-fullname" args)) (defun gud-gdb-marker-filter (string) --- 153,158 ---- (defvar gud-gdb-history nil) ! (defun gud-gdb-massage-args (file args) ! (cons "-fullname" (cons file args))) (defun gud-gdb-marker-filter (string) *************** *** 176,196 **** ;;;###autoload ! (defun gdb (args) "Run gdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger." (interactive ! (list (read-from-minibuffer "Run gdb (like this): gdb " (if (consp gud-gdb-history) (car gud-gdb-history) ! "") nil nil '(gud-gdb-history . 1)))) ! (gud-overload-functions '((gud-debugger-startup . gud-gdb-debugger-startup) ! (gud-marker-filter . gud-gdb-marker-filter) ! (gud-find-file . gud-gdb-find-file) )) ! (gud-common-init args) (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") --- 176,196 ---- ;;;###autoload ! (defun gdb (command-line) "Run gdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger." (interactive ! (list (read-from-minibuffer "Run gdb (like this): " (if (consp gud-gdb-history) (car gud-gdb-history) ! "gdb ") nil nil '(gud-gdb-history . 1)))) ! (gud-overload-functions '((gud-massage-args . gud-gdb-massage-args) ! (gud-marker-filter . gud-gdb-marker-filter) ! (gud-find-file . gud-gdb-find-file) )) ! (gud-common-init command-line) (gud-def gud-break "break %f:%l" "\C-b" "Set breakpoint at current line.") *************** *** 222,227 **** (defvar gud-sdb-lastfile nil) ! (defun gud-sdb-debugger-startup (file args) ! (apply 'make-comint (concat "gud-" file) "sdb" nil args)) (defun gud-sdb-marker-filter (string) --- 222,227 ---- (defvar gud-sdb-lastfile nil) ! (defun gud-sdb-massage-args (file args) ! (cons file args)) (defun gud-sdb-marker-filter (string) *************** *** 256,268 **** ;;;###autoload ! (defun sdb (args) "Run sdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger." (interactive ! (list (read-from-minibuffer "Run sdb (like this): sdb " (if (consp gud-sdb-history) (car gud-sdb-history) ! "") nil nil '(gud-sdb-history . 1)))) --- 256,268 ---- ;;;###autoload ! (defun sdb (command-line) "Run sdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger." (interactive ! (list (read-from-minibuffer "Run sdb (like this): " (if (consp gud-sdb-history) (car gud-sdb-history) ! "sdb ") nil nil '(gud-sdb-history . 1)))) *************** *** 270,279 **** (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name)))) (error "The sdb support requires a valid tags table to work.")) ! (gud-overload-functions '((gud-debugger-startup . gud-sdb-debugger-startup) ! (gud-marker-filter . gud-sdb-marker-filter) ! (gud-find-file . gud-sdb-find-file) )) ! (gud-common-init args) (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.") --- 270,279 ---- (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name)))) (error "The sdb support requires a valid tags table to work.")) ! (gud-overload-functions '((gud-massage-args . gud-sdb-massage-args) ! (gud-marker-filter . gud-sdb-marker-filter) ! (gud-find-file . gud-sdb-find-file) )) ! (gud-common-init command-line) (gud-def gud-break "%l b" "\C-b" "Set breakpoint at current line.") *************** *** 296,301 **** (defvar gud-dbx-history nil) ! (defun gud-dbx-debugger-startup (file args) ! (apply 'make-comint (concat "gud-" file) "dbx" nil args)) (defun gud-dbx-marker-filter (string) --- 296,301 ---- (defvar gud-dbx-history nil) ! (defun gud-dbx-massage-args (file args) ! (cons file args)) (defun gud-dbx-marker-filter (string) *************** *** 313,333 **** ;;;###autoload ! (defun dbx (args) "Run dbx on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger." (interactive ! (list (read-from-minibuffer "Run dbx (like this): dbx " (if (consp gud-dbx-history) (car gud-dbx-history) ! "") nil nil '(gud-dbx-history . 1)))) ! (gud-overload-functions '((gud-debugger-startup . gud-dbx-debugger-startup) ! (gud-marker-filter . gud-dbx-marker-filter) ! (gud-find-file . gud-dbx-find-file) )) ! (gud-common-init args) (gud-def gud-break "stop at \"%f\":%l" --- 313,333 ---- ;;;###autoload ! (defun dbx (command-line) "Run dbx on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory and source-file directory for your debugger." (interactive ! (list (read-from-minibuffer "Run dbx (like this): " (if (consp gud-dbx-history) (car gud-dbx-history) ! "dbx ") nil nil '(gud-dbx-history . 1)))) ! (gud-overload-functions '((gud-massage-args . gud-dbx-massage-args) ! (gud-marker-filter . gud-dbx-marker-filter) ! (gud-find-file . gud-dbx-find-file) )) ! (gud-common-init command-line) (gud-def gud-break "stop at \"%f\":%l" *************** *** 360,372 **** containing the executable being debugged.") ! (defun gud-xdb-debugger-startup (file args) ! (apply 'make-comint (concat "gud-" file) "xdb" nil ! (append (let ((directories gud-xdb-directories) ! (result nil)) ! (while directories ! (setq result (cons (car directories) (cons "-d" result))) ! (setq directories (cdr directories))) ! (nreverse result)) ! args))) (defun gud-xdb-file-name (f) --- 360,371 ---- containing the executable being debugged.") ! (defun gud-xdb-massage-args (file args) ! (nconc (let ((directories gud-xdb-directories) ! (result nil)) ! (while directories ! (setq result (cons (car directories) (cons "-d" result))) ! (setq directories (cdr directories))) ! (nreverse (cons file result))) ! args)) (defun gud-xdb-file-name (f) *************** *** 411,415 **** ;;;###autoload ! (defun xdb (args) "Run xdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory --- 410,414 ---- ;;;###autoload ! (defun xdb (command-line) "Run xdb on program FILE in buffer *gud-FILE*. The directory containing FILE becomes the initial working directory *************** *** 419,433 **** directories if your program contains sources from more than one directory." (interactive ! (list (read-from-minibuffer "Run xdb (like this): xdb " (if (consp gud-xdb-history) (car gud-xdb-history) ! "") nil nil '(gud-xdb-history . 1)))) ! (gud-overload-functions '((gud-debugger-startup . gud-xdb-debugger-startup) ! (gud-marker-filter . gud-xdb-marker-filter) ! (gud-find-file . gud-xdb-find-file))) ! (gud-common-init args) (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") --- 418,432 ---- directories if your program contains sources from more than one directory." (interactive ! (list (read-from-minibuffer "Run xdb (like this): " (if (consp gud-xdb-history) (car gud-xdb-history) ! "xdb ") nil nil '(gud-xdb-history . 1)))) ! (gud-overload-functions '((gud-massage-args . gud-xdb-massage-args) ! (gud-marker-filter . gud-xdb-marker-filter) ! (gud-find-file . gud-xdb-find-file))) ! (gud-common-init command-line) (gud-def gud-break "b %f:%l" "\C-b" "Set breakpoint at current line.") *************** *** 564,598 **** (defvar gud-comint-buffer nil) ! (defun gud-common-init (args) ! ;; Perform initializations common to all debuggers ! ;; There *must* be a cleaner way to lex the arglist... ! (let (file i) ! (if (string= args "") ! (setq args nil) ! (save-excursion ! (set-buffer (get-buffer-create "*gud-scratch*")) ! (erase-buffer) ! (insert args) ! (goto-char (point-max)) ! (insert "\")") ! (goto-char (point-min)) ! (insert "(\"") ! (while (re-search-forward " +" nil t) ! (replace-match "\" \"" nil nil)) ! (goto-char (point-min)) ! (while (re-search-forward "\"\"" nil t) ! (replace-match "" nil nil)) ! (setq args (read (buffer-string))) ! (kill-buffer (current-buffer)))) ! (setq i (1- (length args))) ! (while (and (>= i 0) (not (= (aref (nth i args) 0) ?-))) ! (setq file (nth i args)) (setq i (1- i))) ! (let* ((path (expand-file-name file)) ! (filepart (file-name-nondirectory path))) (switch-to-buffer (concat "*gud-" filepart "*")) ! (setq default-directory (file-name-directory path)) (or (bolp) (newline)) (insert "Current directory is " default-directory "\n") ! (gud-debugger-startup filepart args))) (gud-mode) (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) --- 563,601 ---- (defvar gud-comint-buffer nil) ! ;; Chop STRING into words separated by SPC or TAB and return a list of them. ! (defun gud-chop-words (string) ! (let ((i 0) (beg 0) ! (len (length string)) ! (words nil)) ! (while (< i len) ! (if (memq (aref string i) '(?\t ? )) ! (progn ! (setq words (cons (substring string beg i) words) ! beg (1+ i)) ! (while (and (< beg len) (memq (aref string beg) '(?\t ? ))) ! (setq beg (1+ beg))) ! (setq i (1+ beg))) ! (setq i (1+ i)))) ! (if (< beg len) ! (setq words (cons (substring string beg) words))) ! (nreverse words))) ! ! ;; Perform initializations common to all debuggers. ! (defun gud-common-init (command-line) ! (let* ((words (gud-chop-words command-line)) ! (program (car words)) ! (file-word (let ((w (cdr words))) ! (while (and w (= ?- (aref (car w) 0))) ! (setq w (cdr w))) ! (car w))) ! (args (delq file-word (cdr words))) ! (file (expand-file-name file-word)) ! (filepart (file-name-nondirectory file))) (switch-to-buffer (concat "*gud-" filepart "*")) ! (setq default-directory (file-name-directory file)) (or (bolp) (newline)) (insert "Current directory is " default-directory "\n") ! (apply 'make-comint (concat "gud-" filepart) program nil ! (gud-massage-args file args))) (gud-mode) (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) *************** *** 944,947 **** --- 947,952 ---- ) (t nil)))) + + (provide 'gud) ;;; gud.el ends here diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/hanoi.el emacs-19.17/lisp/hanoi.el *** emacs-19.16/lisp/hanoi.el Wed Jun 9 07:23:33 1993 --- emacs-19.17/lisp/hanoi.el Thu Jul 8 15:06:13 1993 *************** *** 241,243 **** (delete-char 1) (insert ?\|)))))) ! ;;; hanoi.el --- 241,245 ---- (delete-char 1) (insert ?\|)))))) ! (provide 'hanoi) ! ! ;;; hanoi.el ends here diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/hippie-exp.el emacs-19.17/lisp/hippie-exp.el *** emacs-19.16/lisp/hippie-exp.el Wed Mar 17 11:35:00 1993 --- emacs-19.17/lisp/hippie-exp.el Sun Jul 18 02:02:13 1993 *************** *** 1,5 **** ! ;;; hippie.el --- expand a word trying various ways to find its expansion. ;; Author: Anders Holst ;; Keywords: extensions --- 1,7 ---- ! ;;; hippie-exp.el --- expand text trying various ways to find its expansion. ;; Author: Anders Holst + ;; Last change: 22 June 1993 + ;; Version: 1.2 ;; Keywords: extensions *************** *** 21,26 **** ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - ;; - ;; Last change: 4 January 1993 ;;; Commentary: --- 23,26 ---- *************** *** 41,44 **** --- 41,47 ---- ;; currently (ie. was used currently and will be tried first the next ;; time). + ;; The variable `hippie-expand-max-buffers' determines in how many + ;; buffers, apart from the current, to search for expansions in. It + ;; is used by the try-functions named "-all-buffers". ;; See also the macro `make-hippie-expand-function' below. ;; *************** *** 51,55 **** ;; before `try-complete-file-name' for those who want first to get ;; a file name completed only as many characters as is unique. - ;; (NOTE: Not by default in `hippie-expand-try-functions-list'.) ;; `try-expand-all-abbrevs' : can be removed if you don't use abbrevs. ;; Otherwise it looks through all abbrev-tables, starting with --- 54,57 ---- *************** *** 58,66 **** ;; begins exactly as the current line. Convenient sometimes, for ;; example as a substitute for (or complement to) the history ! ;; list in shell-like buffers. Remove it if you find it confusing. ;; `try-expand-line-all-buffers' : Like `try-expand-line' but searches ;; in all buffers (except the current). (This may be a little ! ;; slow, don't use it unless you are really fond of `hippie-expand'. ! ;; NOTE: Not by default in hippie-expand-try-functions-list.) ;; `try-expand-dabbrev' : works exactly as dabbrev-expand (but of ;; course in a way compatible with the other try-functions). --- 60,72 ---- ;; begins exactly as the current line. Convenient sometimes, for ;; example as a substitute for (or complement to) the history ! ;; list in shell-like buffers. At other times, only confusing. ;; `try-expand-line-all-buffers' : Like `try-expand-line' but searches ;; in all buffers (except the current). (This may be a little ! ;; slow, don't use it unless you are really fond of `hippie-expand'.) ! ;; `try-expand-list' : Tries to expand the text back to the nearest ! ;; open delimiter, to a whole list from the buffer. Convenient for ! ;; example when writing lisp or TeX. ! ;; `try-expand-list-all-buffers' : Like `try-expand-list' but searches ! ;; in all buffers (except the current). ;; `try-expand-dabbrev' : works exactly as dabbrev-expand (but of ;; course in a way compatible with the other try-functions). *************** *** 76,82 **** ;; `try-complete-lisp-symbol-partially' : To insert in the list just ;; before `try-complete-lisp-symbol' for those who first want to get ! ;; completion of what is unique in the name. (NOTE: Not by ! ;; default in hippie-expand-try-functions-list.) ;; ;; To write new try-functions, consider the following: ;; Each try-function takes one argument OLD which is nil the first --- 82,98 ---- ;; `try-complete-lisp-symbol-partially' : To insert in the list just ;; before `try-complete-lisp-symbol' for those who first want to get ! ;; completion of what is unique in the name. ;; + ;; Not all of the above functions are by default in + ;; `hippie-expand-try-functions-list'. This variable is better set + ;; in ".emacs" to make `hippie-expand' behave maximally convenient + ;; according to personal taste. Also, instead of loading the + ;; variable with all kinds of try-functions above, it might be an + ;; idea to use `make-hippie-expand-function' to construct different + ;; `hippie-expand'-like functions, with different try-lists and bound + ;; to different keys. It is also possible to make + ;; `hippie-expand-try-functions-list' a buffer local variable, and + ;; let it depend on the mode (by setting it in the mode-hooks). + ;; ;; To write new try-functions, consider the following: ;; Each try-function takes one argument OLD which is nil the first *************** *** 105,110 **** ;; (hint: `he-string-member'), and add its own tried expansions to it. ;; ! ;; ! ;; KNOWN BUGS ;; ;; It may happen that some completion suggestion occurs twice, in --- 121,125 ---- ;; (hint: `he-string-member'), and add its own tried expansions to it. ;; ! ;; Known bugs ;; ;; It may happen that some completion suggestion occurs twice, in *************** *** 117,122 **** ;; suggestion because it thinks it has already tried it. ;; ! ;; ! ;; ACKNOWLEDGEMENT ;; ;; I want to thank Mikael Djurfeldt in discussions with whom the idea --- 132,136 ---- ;; suggestion because it thinks it has already tried it. ;; ! ;; Acknowledgement ;; ;; I want to thank Mikael Djurfeldt in discussions with whom the idea *************** *** 130,136 **** (defvar he-num -1) ! (defvar he-string-beg ()) ! (defvar he-string-end ()) (defvar he-search-string ()) --- 144,150 ---- (defvar he-num -1) ! (defvar he-string-beg (make-marker)) ! (defvar he-string-end (make-marker)) (defvar he-search-string ()) *************** *** 140,144 **** (defvar he-tried-table ()) ! (defvar he-search-loc ()) (defvar he-search-bw ()) --- 154,158 ---- (defvar he-tried-table ()) ! (defvar he-search-loc (make-marker)) (defvar he-search-bw ()) *************** *** 146,149 **** --- 160,166 ---- (defvar he-search-bufs ()) + (defvar he-searched-n-bufs ()) + + ;;;###autoload (defvar hippie-expand-try-functions-list '(try-complete-file-name try-expand-all-abbrevs *************** *** 156,162 **** --- 173,186 ---- or insert functions in this list.") + ;;;###autoload (defvar hippie-expand-verbose t "*Non-nil makes `hippie-expand' output which function it is trying.") + ;;;###autoload + (defvar hippie-expand-max-buffers () + "*The maximum number of buffers (apart from the current) searched. + If nil, all buffers are searched.") + + ;;;###autoload (defun hippie-expand (arg) "Try to expand text before point, using multiple methods. *************** *** 193,197 **** (message "No further expansions found")) (ding)) ! (if hippie-expand-verbose (message (concat "Using " (prin1-to-string (nth he-num --- 217,222 ---- (message "No further expansions found")) (ding)) ! (if (and hippie-expand-verbose ! (not (window-minibuffer-p (selected-window)))) (message (concat "Using " (prin1-to-string (nth he-num *************** *** 201,218 **** (setq he-num -1) (he-reset-string) ! (if hippie-expand-verbose (message "Undoing expansions")))))) ! ;; Initializes the region to expand (to between BEG and END). (defun he-init-string (beg end) ! (setq he-string-beg beg) ! (setq he-string-end end) (setq he-search-string (buffer-substring beg end))) ;; Resets the expanded region to its original contents. (defun he-reset-string () ! (delete-region he-string-beg he-string-end) ! (insert he-search-string) ! (setq he-string-end (point))) ;; Substitutes an expansion STR into the correct region (the region --- 226,249 ---- (setq he-num -1) (he-reset-string) ! (if (and hippie-expand-verbose ! (not (window-minibuffer-p (selected-window)))) (message "Undoing expansions")))))) ! ;; Initializes the region to expand (to between BEG and END). (defun he-init-string (beg end) ! (set-marker he-string-beg beg) ! (set-marker he-string-end end) (setq he-search-string (buffer-substring beg end))) ;; Resets the expanded region to its original contents. (defun he-reset-string () ! (let ((newpos (point-marker))) ! (delete-region he-string-beg he-string-end) ! (goto-char he-string-beg) ! (insert he-search-string) ! (set-marker he-string-end (point)) ! (if (= newpos he-string-beg) ! (goto-char he-string-end) ! (goto-char newpos)))) ;; Substitutes an expansion STR into the correct region (the region *************** *** 225,229 **** case-replace case-fold-search ! (he-transfer-case-ok str he-search-string)))) (he-reset-string) (goto-char he-string-beg) --- 256,261 ---- case-replace case-fold-search ! (he-transfer-case-ok str he-search-string))) ! (newpos (point-marker))) (he-reset-string) (goto-char he-string-beg) *************** *** 232,236 **** (not trans-case) 'literal) ! (setq he-string-end (point)))) (defun he-ordinary-case-p (str) --- 264,271 ---- (not trans-case) 'literal) ! (set-marker he-string-end (point)) ! (if (= newpos he-string-beg) ! (goto-char he-string-end) ! (goto-char newpos)))) (defun he-ordinary-case-p (str) *************** *** 240,244 **** (defun he-transfer-case-ok (to-str from-str) ! (and (not (string= from-str (substring to-str 0 (length from-str)))) ;; otherwise transfer is not needed (and this also solves ;; some obscure situations) --- 275,280 ---- (defun he-transfer-case-ok (to-str from-str) ! (and (not (string= from-str (substring to-str 0 (min (length from-str) ! (length to-str))))) ;; otherwise transfer is not needed (and this also solves ;; some obscure situations) *************** *** 271,279 **** ;; try-expand-line-all-buffers))) ;; (defmacro make-hippie-expand-function (try-list &optional verbose) "Construct a function similar to `hippie-expand'. Make it use the expansion functions in TRY-LIST. An optional second argument VERBOSE non-nil makes the function verbose." ! (` '(lambda (arg) (, (concat "Try to expand text before point, using the following functions: \n" --- 307,316 ---- ;; try-expand-line-all-buffers))) ;; + ;;;###autoload (defmacro make-hippie-expand-function (try-list &optional verbose) "Construct a function similar to `hippie-expand'. Make it use the expansion functions in TRY-LIST. An optional second argument VERBOSE non-nil makes the function verbose." ! (` (function (lambda (arg) (, (concat "Try to expand text before point, using the following functions: \n" *************** *** 282,286 **** (let ((hippie-expand-try-functions-list (, try-list)) (hippie-expand-verbose (, verbose))) ! (hippie-expand arg))))) --- 319,323 ---- (let ((hippie-expand-try-functions-list (, try-list)) (hippie-expand-verbose (, verbose))) ! (hippie-expand arg)))))) *************** *** 313,317 **** (if (null he-expand-list) (progn ! (he-reset-string) ()) (let ((filename (concat (file-name-directory he-search-string) --- 350,354 ---- (if (null he-expand-list) (progn ! (if old (he-reset-string)) ()) (let ((filename (concat (file-name-directory he-search-string) *************** *** 344,348 **** (if (not expansion) (progn ! (he-reset-string) ()) (let ((filename (concat (file-name-directory he-search-string) --- 381,385 ---- (if (not expansion) (progn ! (if old (he-reset-string)) ()) (let ((filename (concat (file-name-directory he-search-string) *************** *** 381,385 **** (if (null he-expand-list) (progn ! (he-reset-string) ()) (progn --- 418,422 ---- (if (null he-expand-list) (progn ! (if old (he-reset-string)) ()) (progn *************** *** 411,415 **** (if (not expansion) (progn ! (he-reset-string) ()) (progn --- 448,452 ---- (if (not expansion) (progn ! (if old (he-reset-string)) ()) (progn *************** *** 431,439 **** (let ((expansion ()) (strip-prompt (and (get-buffer-process (current-buffer)) ! shell-prompt-pattern))) (if (not old) (progn (he-init-string (he-line-beg strip-prompt) (point)) ! (setq he-search-loc he-string-beg) (setq he-search-bw t))) --- 468,476 ---- (let ((expansion ()) (strip-prompt (and (get-buffer-process (current-buffer)) ! comint-prompt-regexp))) (if (not old) (progn (he-init-string (he-line-beg strip-prompt) (point)) ! (set-marker he-search-loc he-string-beg) (setq he-search-bw t))) *************** *** 446,453 **** (setq expansion (he-line-search he-search-string strip-prompt t)) ! (setq he-search-loc (point-marker)) (if (not expansion) (progn ! (setq he-search-loc he-string-end) (setq he-search-bw ()))))) --- 483,490 ---- (setq expansion (he-line-search he-search-string strip-prompt t)) ! (set-marker he-search-loc (point)) (if (not expansion) (progn ! (set-marker he-search-loc he-string-end) (setq he-search-bw ()))))) *************** *** 457,465 **** (setq expansion (he-line-search he-search-string strip-prompt nil)) ! (setq he-search-loc (point-marker)))))) (if (not expansion) (progn ! (he-reset-string) ()) (progn --- 494,502 ---- (setq expansion (he-line-search he-search-string strip-prompt nil)) ! (set-marker he-search-loc (point)))))) (if (not expansion) (progn ! (if old (he-reset-string)) ()) (progn *************** *** 475,507 **** (let ((expansion ()) (strip-prompt (and (get-buffer-process (current-buffer)) ! shell-prompt-pattern)) (buf (current-buffer))) (if (not old) (progn (he-init-string (he-line-beg strip-prompt) (point)) ! (setq he-search-loc 0) ! (setq he-search-bufs (buffer-list)))) (if (not (equal he-search-string "")) ! (while (and he-search-bufs (not expansion)) (set-buffer (car he-search-bufs)) (if (and (not (eq (current-buffer) buf)) (not (eq major-mode 'dired-mode))) ! ;; dont search dired buffers (save-excursion (goto-char he-search-loc) (setq expansion (he-line-search he-search-string strip-prompt nil)) ! (setq he-search-loc (point-marker)))) ! (if expansion ! (setq he-tried-table (cons expansion he-tried-table)) ! (progn ! (setq he-search-loc 0) ! (setq he-search-bufs (cdr he-search-bufs)))))) (set-buffer buf) (if (not expansion) (progn ! (he-reset-string) ()) (progn --- 512,554 ---- (let ((expansion ()) (strip-prompt (and (get-buffer-process (current-buffer)) ! comint-prompt-regexp)) (buf (current-buffer))) (if (not old) (progn (he-init-string (he-line-beg strip-prompt) (point)) ! (setq he-search-bufs (buffer-list)) ! (setq he-searched-n-bufs 0) ! (set-marker he-search-loc 1 (car he-search-bufs)))) (if (not (equal he-search-string "")) ! (while (and he-search-bufs ! (not expansion) ! (or (not hippie-expand-max-buffers) ! (< he-searched-n-bufs hippie-expand-max-buffers))) (set-buffer (car he-search-bufs)) (if (and (not (eq (current-buffer) buf)) + (not (string-match " \\*Minibuf-[0-9]+\\*" + (buffer-name (current-buffer)))) (not (eq major-mode 'dired-mode))) ! ;; Dont search minibuffers nor dired buffers (save-excursion (goto-char he-search-loc) + (setq strip-prompt (and (get-buffer-process (current-buffer)) + comint-prompt-regexp)) (setq expansion (he-line-search he-search-string strip-prompt nil)) ! (set-marker he-search-loc (point)) ! (if expansion ! (setq he-tried-table (cons expansion he-tried-table)) ! (setq he-search-bufs (cdr he-search-bufs)) ! (setq he-searched-n-bufs (1+ he-searched-n-bufs)) ! (set-marker he-search-loc 1 (car he-search-bufs)))) ! (setq he-search-bufs (cdr he-search-bufs)) ! (set-marker he-search-loc 1 (car he-search-bufs))))) (set-buffer buf) (if (not expansion) (progn ! (if old (he-reset-string)) ()) (progn *************** *** 536,540 **** (defun he-line-search-regexp (pat strip-prompt) (if strip-prompt ! (concat "\\(" shell-prompt-pattern "\\|^\\s-*\\)\\(" (regexp-quote pat) "[^\n]*[^ \t\n]\\)") --- 583,587 ---- (defun he-line-search-regexp (pat strip-prompt) (if strip-prompt ! (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\(" (regexp-quote pat) "[^\n]*[^ \t\n]\\)") *************** *** 543,546 **** --- 590,708 ---- "[^\n]*[^ \t\n]\\)"))) + (defun try-expand-list (old) + "Try to complete the current beginning of a list. + The argument OLD has to be nil the first call of this function, and t + for subsequent calls (for further possible completions of the same + string). It returns t if a new completion is found, nil otherwise." + (let ((expansion ())) + (if (not old) + (progn + (he-init-string (he-list-beg) (point)) + (set-marker he-search-loc he-string-beg) + (setq he-search-bw t))) + + (if (not (equal he-search-string "")) + (save-excursion + ;; Try looking backward unless inhibited. + (if he-search-bw + (progn + (goto-char he-search-loc) + (setq expansion (he-list-search he-search-string t)) + (set-marker he-search-loc (point)) + (if (not expansion) + (progn + (set-marker he-search-loc he-string-end) + (setq he-search-bw ()))))) + + (if (not expansion) ; Then look forward. + (progn + (goto-char he-search-loc) + (setq expansion (he-list-search he-search-string nil)) + (set-marker he-search-loc (point)))))) + + (if (not expansion) + (progn + (if old (he-reset-string)) + ()) + (progn + (he-substitute-string expansion t) + (setq he-tried-table (cons expansion he-tried-table)) + t)))) + + (defun try-expand-list-all-buffers (old) + "Try to complete the current list, searching all other buffers. + The argument OLD has to be nil the first call of this function, and t + for subsequent calls (for further possible completions of the same + string). It returns t if a new completion is found, nil otherwise." + (let ((expansion ()) + (buf (current-buffer))) + (if (not old) + (progn + (he-init-string (he-list-beg) (point)) + (setq he-search-bufs (buffer-list)) + (setq he-searched-n-bufs 0) + (set-marker he-search-loc 1 (car he-search-bufs)))) + + (if (not (equal he-search-string "")) + (while (and he-search-bufs + (not expansion) + (or (not hippie-expand-max-buffers) + (< he-searched-n-bufs hippie-expand-max-buffers))) + (set-buffer (car he-search-bufs)) + (if (and (not (eq (current-buffer) buf)) + (not (string-match " \\*Minibuf-[0-9]+\\*" + (buffer-name (current-buffer)))) + (not (eq major-mode 'dired-mode))) + ;; Dont search minibuffers nor dired buffers + (save-excursion + (goto-char he-search-loc) + (setq expansion (he-list-search he-search-string nil)) + (set-marker he-search-loc (point)) + (if expansion + (setq he-tried-table (cons expansion he-tried-table)) + (setq he-search-bufs (cdr he-search-bufs)) + (setq he-searched-n-bufs (1+ he-searched-n-bufs)) + (set-marker he-search-loc 1 (car he-search-bufs)))) + (setq he-search-bufs (cdr he-search-bufs)) + (set-marker he-search-loc 1 (car he-search-bufs))))) + + (set-buffer buf) + (if (not expansion) + (progn + (if old (he-reset-string)) + ()) + (progn + (he-substitute-string expansion t) + t)))) + + (defun he-list-search (str reverse) + (let ((result ()) + beg pos err) + (while (and (not result) + (if reverse + (search-backward str nil t) + (search-forward str nil t))) + (setq pos (point)) + (setq beg (match-beginning 0)) + (goto-char beg) + (setq err ()) + (condition-case () + (forward-list 1) + (error (setq err t))) + (if (not err) + (progn + (setq result (buffer-substring beg (point))) + (if (he-string-member result he-tried-table) + (setq result nil)))) ; if already in table, ignore + (goto-char pos)) + result)) + + (defun he-list-beg () + (save-excursion + (condition-case () + (backward-up-list 1) + (error ())) + (point))) + (defun try-expand-all-abbrevs (old) "Try to expand word before point according to all abbrev tables. *************** *** 554,558 **** (and (not (equal he-search-string "")) (mapcar (function (lambda (sym) ! (abbrev-expansion he-search-string (eval sym)))) (append '(local-abbrev-table --- 716,720 ---- (and (not (equal he-search-string "")) (mapcar (function (lambda (sym) ! (abbrev-expansion (downcase he-search-string) (eval sym)))) (append '(local-abbrev-table *************** *** 565,572 **** (if (null he-expand-list) (progn ! (he-reset-string) ()) (progn ! (he-substitute-string (car he-expand-list)) (setq he-tried-table (cons (car he-expand-list) he-tried-table)) (setq he-expand-list (cdr he-expand-list)) --- 727,734 ---- (if (null he-expand-list) (progn ! (if old (he-reset-string)) ()) (progn ! (he-substitute-string (car he-expand-list) t) (setq he-tried-table (cons (car he-expand-list) he-tried-table)) (setq he-expand-list (cdr he-expand-list)) *************** *** 582,586 **** (progn (he-init-string (he-dabbrev-beg) (point)) ! (setq he-search-loc he-string-beg) (setq he-search-bw t))) --- 744,748 ---- (progn (he-init-string (he-dabbrev-beg) (point)) ! (set-marker he-search-loc he-string-beg) (setq he-search-bw t))) *************** *** 592,599 **** (goto-char he-search-loc) (setq expansion (he-dab-search he-search-string t)) ! (setq he-search-loc (point-marker)) (if (not expansion) (progn ! (setq he-search-loc he-string-end) (setq he-search-bw ()))))) --- 754,761 ---- (goto-char he-search-loc) (setq expansion (he-dab-search he-search-string t)) ! (set-marker he-search-loc (point)) (if (not expansion) (progn ! (set-marker he-search-loc he-string-end) (setq he-search-bw ()))))) *************** *** 602,610 **** (goto-char he-search-loc) (setq expansion (he-dab-search he-search-string nil)) ! (setq he-search-loc (point-marker)))))) (if (not expansion) (progn ! (he-reset-string) ()) (progn --- 764,772 ---- (goto-char he-search-loc) (setq expansion (he-dab-search he-search-string nil)) ! (set-marker he-search-loc (point)))))) (if (not expansion) (progn ! (if old (he-reset-string)) ()) (progn *************** *** 623,649 **** (progn (he-init-string (he-dabbrev-beg) (point)) ! (setq he-search-loc 0) ! (setq he-search-bufs (buffer-list)))) (if (not (equal he-search-string "")) ! (while (and he-search-bufs (not expansion)) (set-buffer (car he-search-bufs)) (if (and (not (eq (current-buffer) buf)) ! (not (eq major-mode 'dired-mode))) ! ;; dont search dired buffers (save-excursion (goto-char he-search-loc) (setq expansion (he-dab-search he-search-string nil)) ! (setq he-search-loc (point-marker)))) ! (if expansion ! (setq he-tried-table (cons expansion he-tried-table)) ! (progn ! (setq he-search-loc 0) ! (setq he-search-bufs (cdr he-search-bufs)))))) (set-buffer buf) (if (not expansion) (progn ! (he-reset-string) ()) (progn --- 785,819 ---- (progn (he-init-string (he-dabbrev-beg) (point)) ! (setq he-search-bufs (buffer-list)) ! (setq he-searched-n-bufs 0) ! (set-marker he-search-loc 1 (car he-search-bufs)))) (if (not (equal he-search-string "")) ! (while (and he-search-bufs ! (not expansion) ! (or (not hippie-expand-max-buffers) ! (< he-searched-n-bufs hippie-expand-max-buffers))) (set-buffer (car he-search-bufs)) (if (and (not (eq (current-buffer) buf)) ! (not (string-match " \\*Minibuf-[0-9]+\\*" ! (buffer-name (current-buffer)))) ! (not (eq major-mode 'dired-mode))) ! ;; Dont search minibuffers nor dired buffers (save-excursion (goto-char he-search-loc) (setq expansion (he-dab-search he-search-string nil)) ! (set-marker he-search-loc (point)) ! (if expansion ! (setq he-tried-table (cons expansion he-tried-table)) ! (setq he-search-bufs (cdr he-search-bufs)) ! (setq he-searched-n-bufs (1+ he-searched-n-bufs)) ! (set-marker he-search-loc 1 (car he-search-bufs)))) ! (setq he-search-bufs (cdr he-search-bufs)) ! (set-marker he-search-loc 1 (car he-search-bufs))))) (set-buffer buf) (if (not expansion) (progn ! (if old (he-reset-string)) ()) (progn *************** *** 669,677 **** (defun he-dabbrev-beg () ! (let ((skips "-a-zA-Z0-9_.")) ! (save-excursion ! (skip-chars-backward skips) ! (skip-chars-forward "-_.") ! (point)))) ! ;;; hippie.el ends here --- 839,848 ---- (defun he-dabbrev-beg () ! (save-excursion ! (skip-syntax-backward "w_") ! (skip-syntax-forward "_") ! (point))) ! ! (provide 'hippie-exp) ! ;;; hippie-exp.el ends here diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/isearch.el emacs-19.17/lisp/isearch.el *** emacs-19.16/lisp/isearch.el Fri Jul 2 17:34:19 1993 --- emacs-19.17/lisp/isearch.el Wed Jul 14 23:46:06 1993 *************** *** 5,9 **** ;; Author: Daniel LaLiberte ! ;; |$Date: 1993/07/02 21:34:15 $|$Revision: 1.44 $ ;; This file is not yet part of GNU Emacs, but it is based almost --- 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 *************** *** 590,595 **** (progn (push-mark isearch-opoint t) ! (if transient-mark-mode ! (setq mark-active nil)) (or executing-macro (> (minibuffer-depth) 0) (message "Mark saved where search started"))) --- 590,594 ---- (progn (push-mark isearch-opoint t) ! (deactivate-mark) (or executing-macro (> (minibuffer-depth) 0) (message "Mark saved where search started"))) *************** *** 677,681 **** (interactive) (condition-case err ! (let (isearch-nonincremental ; should search nonincrementally? ;; Locally bind all isearch global variables to protect them --- 676,680 ---- (interactive) (condition-case err ! (let ((isearch-nonincremental isearch-nonincremental) ;; Locally bind all isearch global variables to protect them diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/ispell.el emacs-19.17/lisp/ispell.el *** emacs-19.16/lisp/ispell.el Sun Jun 13 23:51:11 1993 --- emacs-19.17/lisp/ispell.el Thu Jul 15 02:55:06 1993 *************** *** 1,5 **** ;;; ispell.el --- this is the GNU EMACS interface to GNU ISPELL version 4. ! ;;Copyright (C) 1990, 1991 Free Software Foundation, Inc. ;; Keywords: wp --- 1,5 ---- ;;; ispell.el --- this is the GNU EMACS interface to GNU ISPELL version 4. ! ;;Copyright (C) 1990, 1991, 1993 Free Software Foundation, Inc. ;; Keywords: wp *************** *** 63,67 **** ;; Non-nil means we have started showing an alternatives window. ;; This is the window config from before then. ! (defvar ispell-window-configuration) ;t when :dump command needed --- 63,67 ---- ;; Non-nil means we have started showing an alternatives window. ;; This is the window config from before then. ! (defvar ispell-window-configuration nil) ;t when :dump command needed *************** *** 214,217 **** --- 214,235 ---- (memq major-mode '(plain-TeX-mode LaTeX-mode))) + (defvar ispell-menu-map (make-sparse-keymap "Spell")) + (defalias 'ispell-menu-map ispell-menu-map) + + (define-key ispell-menu-map [reload-ispell] + '("Reload Dictionary" . reload-ispell)) + + (define-key ispell-menu-map [ispell-next] + '("Continue Check" . ispell-next)) + + (define-key ispell-menu-map [ispell-region] + '("Check Region" . ispell-region)) + + (define-key ispell-menu-map [ispell-buffer] + '("Check Buffer" . ispell)) + + (define-key ispell-menu-map [ispell-word] + '("Check Word" . ispell-word)) + ;;;###autoload (defun ispell (&optional buf start end) *************** *** 246,253 **** ;; Deactivate the mark, because we'll do it anyway if we change something, ;; and a region highlight while in the Ispell loop is distracting. ! (if transient-mark-mode ! (progn ! (setq mark-active nil) ! (run-hooks 'deactivate-mark-hook))) (save-excursion (set-buffer buf) --- 264,268 ---- ;; Deactivate the mark, because we'll do it anyway if we change something, ;; and a region highlight while in the Ispell loop is distracting. ! (deactivate-mark) (save-excursion (set-buffer buf) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/loaddefs.el emacs-19.17/lisp/loaddefs.el *** emacs-19.16/lisp/loaddefs.el Mon Jun 21 14:24:59 1993 --- emacs-19.17/lisp/loaddefs.el Sun Jul 18 04:05:33 1993 *************** *** 73,77 **** (defconst mode-line-buffer-identification (purecopy '("Emacs: %12b")) "Mode-line control for identifying the buffer being displayed. ! Its default value is \"Emacs: %17b\". Major modes that edit things other than ordinary files may change this (e.g. Info, Dired,...)") --- 73,77 ---- (defconst mode-line-buffer-identification (purecopy '("Emacs: %12b")) "Mode-line control for identifying the buffer being displayed. ! Its default value is \"Emacs: %12b\". Major modes that edit things other than ordinary files may change this (e.g. Info, Dired,...)") *************** *** 237,240 **** --- 237,241 ---- (define-key global-map [prior] 'scroll-down) (define-key global-map [next] 'scroll-up) + (define-key global-map [M-next] 'scroll-other-window) (define-key global-map [end] 'end-of-buffer) (define-key global-map [begin] 'beginning-of-buffer) *************** *** 408,412 **** (define-key ctl-x-map "aig" 'inverse-add-global-abbrev) (define-key ctl-x-map "ail" 'inverse-add-mode-abbrev) ! (define-key ctl-x-map "a\C-h" 'inverse-add-global-abbrev) (define-key ctl-x-map "a-" 'inverse-add-global-abbrev) (define-key ctl-x-map "ae" 'expand-abbrev) --- 409,413 ---- (define-key ctl-x-map "aig" 'inverse-add-global-abbrev) (define-key ctl-x-map "ail" 'inverse-add-mode-abbrev) ! ;; (define-key ctl-x-map "a\C-h" 'inverse-add-global-abbrev) (define-key ctl-x-map "a-" 'inverse-add-global-abbrev) (define-key ctl-x-map "ae" 'expand-abbrev) *************** *** 429,433 **** ;;; (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" (11285 49636)) ;;; 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" (11318 13833)) ;;; Generated autoloads from add-log.el *************** *** 468,475 **** ;;;*** ! ;;;### (autoloads (ad-start-advice defadvice ad-add-advice) "advice" "advice.el" (11266 60950)) ;;; Generated autoloads from advice.el ! (defvar ad-start-advice-on-load nil "\ *Non-NIL will start advice magic when this file gets loaded. Also see function `ad-start-advice'.") --- 469,476 ---- ;;;*** ! ;;;### (autoloads (ad-start-advice defadvice ad-add-advice) "advice" "advice.el" (11335 1783)) ;;; Generated autoloads from advice.el ! (defvar ad-start-advice-on-load t "\ *Non-NIL will start advice magic when this file gets loaded. Also see function `ad-start-advice'.") *************** *** 584,593 **** ;;;*** ! ;;;### (autoloads (ange-ftp-hook-function) "ange-ftp" "ange-ftp.el" (11287 33186)) ;;; Generated autoloads from ange-ftp.el (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))) ;;;*** --- 585,594 ---- ;;;*** ! ;;;### (autoloads (ange-ftp-hook-function) "ange-ftp" "ange-ftp.el" (11336 60199)) ;;; Generated autoloads from ange-ftp.el (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))) ;;;*** *************** *** 673,677 **** ;;;*** ! ;;;### (autoloads (batch-update-autoloads update-directory-autoloads update-autoloads-here update-file-autoloads) "autoload" "autoload.el" (11295 42814)) ;;; Generated autoloads from autoload.el --- 674,678 ---- ;;;*** ! ;;;### (autoloads (batch-update-autoloads update-directory-autoloads update-autoloads-here update-file-autoloads) "autoload" "autoload.el" (11332 29335)) ;;; Generated autoloads from autoload.el *************** *** 973,977 **** ;;;*** ! ;;;### (autoloads (batch-byte-compile display-call-tree byte-compile compile-defun byte-compile-file byte-recompile-directory) "bytecomp" "bytecomp.el" (11295 23399)) ;;; Generated autoloads from bytecomp.el --- 974,978 ---- ;;;*** ! ;;;### (autoloads (batch-byte-compile display-call-tree byte-compile compile-defun byte-compile-file byte-recompile-directory) "bytecomp" "bytecomp.el" (11336 59225)) ;;; Generated autoloads from bytecomp.el *************** *** 1023,1027 **** ;;;*** ! ;;;### (autoloads (list-yahrzeit-dates calendar) "calendar" "calendar.el" (11292 39079)) ;;; Generated autoloads from calendar.el --- 1024,1028 ---- ;;;*** ! ;;;### (autoloads (list-yahrzeit-dates calendar) "calendar" "calendar.el" (11327 35047)) ;;; Generated autoloads from calendar.el *************** *** 1055,1061 **** (defvar view-calendar-holidays-initially nil "\ ! *If t, the holidays for the current three month period will be displayed ! on entry. The holidays are displayed in another window when the calendar is ! first displayed.") (defvar mark-holidays-in-calendar nil "\ --- 1056,1062 ---- (defvar view-calendar-holidays-initially nil "\ ! *If t, holidays for current three month period will be displayed on entry. ! The holidays are displayed in another window when the calendar is first ! displayed.") (defvar mark-holidays-in-calendar nil "\ *************** *** 1067,1086 **** (defvar all-hebrew-calendar-holidays nil "\ ! *If nil, the holidays from the Hebrew calendar that are shown will ! include only those days of such major interest as to appear on secular ! calendars. If t, the holidays shown in the calendar will include all ! special days that would be shown on a complete Hebrew calendar.") (defvar all-christian-calendar-holidays nil "\ ! *If nil, the holidays from the Christian calendar that are shown will ! include only those days of such major interest as to appear on secular ! calendars. If t, the holidays shown in the calendar will include all ! special days that would be shown on a complete Christian calendar.") (defvar all-islamic-calendar-holidays nil "\ ! *If nil, the holidays from the Islamic calendar that are shown will ! include only those days of such major interest as to appear on secular ! calendars. If t, the holidays shown in the calendar will include all ! special days that would be shown on a complete Islamic calendar.") (defvar calendar-load-hook nil "\ --- 1068,1096 ---- (defvar all-hebrew-calendar-holidays nil "\ ! *If nil, show only major holidays from the Hebrew calendar. + If nil, the only holidays from the Hebrew calendar shown will be those days of + such major interest as to appear on secular calendars. + + If t, the holidays shown in the calendar will include all special days that + would be shown on a complete Hebrew calendar.") + (defvar all-christian-calendar-holidays nil "\ ! *If nil, show only major holidays from the Christian calendar. ! ! If nil, the only holidays from the Christian calendar shown will be those days ! of such major interest as to appear on secular calendars. + If t, the holidays shown in the calendar will include all special days that + would be shown on a complete Christian calendar.") + (defvar all-islamic-calendar-holidays nil "\ ! *If nil, show only major holidays from the Islamic calendar. ! ! If nil, the only holidays from the Islamic calendar shown will be those days ! of such major interest as to appear on secular calendars. ! ! If t, the holidays shown in the calendar will include all special days that ! would be shown on a complete Islamic calendar.") (defvar calendar-load-hook nil "\ *************** *** 1218,1236 **** (defvar diary-nonmarking-symbol "&" "\ ! *The symbol used to indicate that a diary entry is not to be marked in the ! calendar window.") (defvar hebrew-diary-entry-symbol "H" "\ ! *The symbol used to indicate that a diary entry is according to the ! Hebrew calendar.") (defvar islamic-diary-entry-symbol "I" "\ ! *The symbol used to indicate that a diary entry is according to the ! Islamic calendar.") (defvar diary-include-string "#include" "\ ! *The string used to indicate the inclusion of another file of diary entries ! in diary-file. See the documentation for the function ! `include-other-diary-files'.") (defvar sexp-diary-entry-symbol "%%" "\ --- 1228,1242 ---- (defvar diary-nonmarking-symbol "&" "\ ! *Symbol indicating that a diary entry is not to be marked in the calendar.") (defvar hebrew-diary-entry-symbol "H" "\ ! *Symbol indicating a diary entry according to the Hebrew calendar.") (defvar islamic-diary-entry-symbol "I" "\ ! *Symbol indicating a diary entry according to the Islamic calendar.") (defvar diary-include-string "#include" "\ ! *The string indicating inclusion of another file of diary entries. ! See the documentation for the function `include-other-diary-files'.") (defvar sexp-diary-entry-symbol "%%" "\ *************** *** 1239,1250 **** (defvar abbreviated-calendar-year t "\ ! *Interpret a two-digit year DD in a diary entry as being either 19DD or ! 20DD, as appropriate, for the Gregorian calendar; similarly for the Hebrew and ! Islamic calendars. If this variable is nil, years must be written in full.") (defvar european-calendar-style nil "\ ! *Use the European style of dates in the diary and in any displays. If this ! variable is t, a date 1/2/1990 would be interpreted as February 1, 1990. ! The accepted European date styles are DAY/MONTH --- 1245,1256 ---- (defvar abbreviated-calendar-year t "\ ! *Interpret a two-digit year DD in a diary entry as either 19DD or 20DD. ! For the Gregorian calendar; similarly for the Hebrew and Islamic calendars. ! If this variable is nil, years must be written in full.") (defvar european-calendar-style nil "\ ! *Use the European style of dates in the diary and in any displays. ! If this variable is t, a date 1/2/1990 would be interpreted as February 1, ! 1990. The accepted European date styles are DAY/MONTH *************** *** 1290,1310 **** (defvar european-calendar-display-form (quote ((if dayname (concat dayname ", ")) day " " monthname " " year)) "\ ! *The pseudo-pattern that governs the way a Gregorian date is formatted ! in the European style. See the documentation of calendar-date-display-forms ! for an explanation.") (defvar american-calendar-display-form (quote ((if dayname (concat dayname ", ")) monthname " " day ", " year)) "\ ! *The pseudo-pattern that governs the way a Gregorian date is formatted ! in the American style. See the documentation of calendar-date-display-forms ! for an explanation.") (defvar calendar-date-display-form (if european-calendar-style european-calendar-display-form american-calendar-display-form) "\ ! *The pseudo-pattern that governs the way a Gregorian date is formatted ! as a string by the function `calendar-date-string'. A pseudo-pattern is a ! list of expressions that can involve the keywords `month', `day', and ! `year', all numbers in string form, and `monthname' and `dayname', both ! alphabetic strings. For example, the ISO standard would use the pseudo- ! pattern '(year \"-\" month \"-\" day) --- 1296,1314 ---- (defvar european-calendar-display-form (quote ((if dayname (concat dayname ", ")) day " " monthname " " year)) "\ ! *Pseudo-pattern governing the way a date appears in the European style. ! See the documentation of calendar-date-display-forms for an explanation.") (defvar american-calendar-display-form (quote ((if dayname (concat dayname ", ")) monthname " " day ", " year)) "\ ! *Pseudo-pattern governing the way a date appears in the American style. ! See the documentation of calendar-date-display-forms for an explanation.") (defvar calendar-date-display-form (if european-calendar-style european-calendar-display-form american-calendar-display-form) "\ ! *Pseudo-pattern governing the way a date appears. + Used by the function `calendar-date-string', a pseudo-pattern is a list of + expressions that can involve the keywords `month', `day', and `year', all + numbers in string form, and `monthname' and `dayname', both alphabetic + strings. For example, the ISO standard would use the pseudo- pattern + '(year \"-\" month \"-\" day) *************** *** 1321,1362 **** See the documentation of the function `calendar-date-string'.") - (defvar calendar-time-display-form (quote (12-hours ":" minutes am-pm (if time-zone " (") time-zone (if time-zone ")"))) "\ - *The pseudo-pattern that governs the way a time of day is formatted. - - A pseudo-pattern is a list of expressions that can involve the keywords - `12-hours', `24-hours', and `minutes', all numbers in string form, - and `am-pm' and `time-zone', both alphabetic strings. - - For example, the form - - '(24-hours \":\" minutes - (if time-zone \" (\") time-zone (if time-zone \")\")) - - would give military-style times like `21:07 (UT)'.") - - (defvar calendar-latitude nil "\ - *Latitude of `calendar-location-name' in degrees, + north, - south. - For example, 40.7 for New York City.") - - (defvar calendar-longitude nil "\ - *Longitude of `calendar-location-name' in degrees, + east, - west. - For example, -74.0 for New York City.") - - (defvar calendar-location-name (quote (let ((float-output-format "%.1f")) (format "%s%s, %s%s" (abs calendar-latitude) (if (> calendar-latitude 0) "N" "S") (abs calendar-longitude) (if (> calendar-longitude 0) "E" "W")))) "\ - *An expression that evaluates to the name of the location at - `calendar-longitude', calendar-latitude'. Default value is just the latitude, - longitude pair.") - (defvar print-diary-entries-hook (quote lpr-buffer) "\ ! *List of functions to be called after a temporary buffer is prepared with ! the diary entries currently visible in the diary buffer. The default just ! does the printing. Other uses might include, for example, rearranging the ! lines into order by day and time, saving the buffer instead of deleting it, or ! changing the function used to do the printing.") (defvar list-diary-entries-hook nil "\ ! *List of functions to be called after the diary file is culled for ! relevant entries. It is to be used for diary entries that are not found in ! the diary file. A function `include-other-diary-files' is provided for use as the value of --- 1325,1338 ---- See the documentation of the function `calendar-date-string'.") (defvar print-diary-entries-hook (quote lpr-buffer) "\ ! *List of functions called after a temporary diary buffer is prepared. ! The buffer shows only the diary entries currently visible in the diary ! buffer. The default just does the printing. Other uses might include, for ! example, rearranging the lines into order by day and time, saving the buffer ! instead of deleting it, or changing the function used to do the printing.") (defvar list-diary-entries-hook nil "\ ! *List of functions called after diary file is culled for relevant entries. ! It is to be used for diary entries that are not found in the diary file. A function `include-other-diary-files' is provided for use as the value of *************** *** 1405,1412 **** (defvar nongregorian-diary-listing-hook nil "\ ! *List of functions to be called for the diary file and included files as ! they are processed for listing diary entries. You can use any or all of ! `list-hebrew-diary-entries' and `list-islamic-diary-entries'. The ! documentation for these functions describes the style of such diary entries.") (defvar mark-diary-entries-hook nil "\ --- 1381,1389 ---- (defvar nongregorian-diary-listing-hook nil "\ ! *List of functions called for listing diary file and included files. ! As the files are processed for diary entries, these functions are used to cull ! relevant entries. You can use either or both of `list-hebrew-diary-entries' ! and `list-islamic-diary-entries'. The documentation for these functions ! describes the style of such diary entries.") (defvar mark-diary-entries-hook nil "\ *************** *** 1425,1446 **** (defvar nongregorian-diary-marking-hook nil "\ ! *List of functions to be called as the diary file and included files are ! processed for marking diary entries. You can use either or both of ! mark-hebrew-diary-entries and mark-islamic-diary-entries. The documentation ! for these functions describes the style of such diary entries.") (defvar diary-list-include-blanks nil "\ ! *If nil, do not include days with no diary entry in the list of diary ! entries. Such days will then not be shown in the the fancy diary buffer, ! even if they are holidays.") (defvar holidays-in-diary-buffer t "\ ! *If t, the holidays will be indicated in the mode line of the diary buffer ! (or in the fancy diary buffer next to the date). This slows down the diary ! functions somewhat; setting it to nil will make the diary display faster.") ! ! (defvar general-holidays (quote ((fixed 1 1 "New Year's Day") (float 1 1 3 "Martin Luther King Day") (fixed 2 2 "Ground Hog Day") (fixed 2 14 "Valentine's Day") (float 2 1 3 "President's Day") (fixed 3 17 "St. Patrick's Day") (fixed 4 1 "April Fool's Day") (float 5 0 2 "Mother's Day") (float 5 1 -1 "Memorial Day") (fixed 6 14 "Flag Day") (float 6 0 3 "Father's Day") (fixed 7 4 "Independence Day") (float 9 1 1 "Labor Day") (float 10 1 2 "Columbus Day") (fixed 10 31 "Halloween") (fixed 11 11 "Veteran's Day") (float 11 4 4 "Thanksgiving"))) "\ ! *General holidays. Default value is for the United States. See the ! documentation for `calendar-holidays' for details.") (defvar local-holidays nil "\ --- 1402,1425 ---- (defvar nongregorian-diary-marking-hook nil "\ ! *List of functions called for marking diary file and included files. ! As the files are processed for diary entries, these functions are used to cull ! relevant entries. You can use either or both of `mark-hebrew-diary-entries' ! and `mark-islamic-diary-entries'. The documentation for these functions ! describes the style of such diary entries.") (defvar diary-list-include-blanks nil "\ ! *If nil, do not include days with no diary entry in the list of diary entries. ! Such days will then not be shown in the the fancy diary buffer, even if they ! are holidays.") (defvar holidays-in-diary-buffer t "\ ! *If t, the holidays will be indicated in the diary display. ! The holidays will be given in the mode line of the diary buffer, or in the ! fancy diary buffer next to the date. This slows down the diary functions ! somewhat; setting it to nil will make the diary display faster.") ! ! (defvar general-holidays (quote ((holiday-fixed 1 1 "New Year's Day") (holiday-float 1 1 3 "Martin Luther King Day") (holiday-fixed 2 2 "Ground Hog Day") (holiday-fixed 2 14 "Valentine's Day") (holiday-float 2 1 3 "President's Day") (holiday-fixed 3 17 "St. Patrick's Day") (holiday-fixed 4 1 "April Fool's Day") (holiday-float 5 0 2 "Mother's Day") (holiday-float 5 1 -1 "Memorial Day") (holiday-fixed 6 14 "Flag Day") (holiday-float 6 0 3 "Father's Day") (holiday-fixed 7 4 "Independence Day") (holiday-float 9 1 1 "Labor Day") (holiday-float 10 1 2 "Columbus Day") (holiday-fixed 10 31 "Halloween") (holiday-fixed 11 11 "Veteran's Day") (holiday-float 11 4 4 "Thanksgiving"))) "\ ! *General holidays. Default value is for the United States. ! See the documentation for `calendar-holidays' for details.") (defvar local-holidays nil "\ *************** *** 1452,1564 **** See the documentation for `calendar-holidays' for details.") ! (defvar hebrew-holidays (quote ((rosh-hashanah-etc) (if all-hebrew-calendar-holidays (julian 11 (let* ((m displayed-month) (y displayed-year) (year)) (increment-calendar-month m y -1) (let ((year (extract-calendar-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m 1 y)))))) (if (zerop (% (1+ year) 4)) 22 21))) "\"Tal Umatar\" (evening)")) (if all-hebrew-calendar-holidays (hanukkah) (hebrew 9 25 "Hanukkah")) (if all-hebrew-calendar-holidays (hebrew 10 (let ((h-year (extract-calendar-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (list displayed-month 28 displayed-year)))))) (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year)) 7) 6) 11 10)) "Tzom Teveth")) (if all-hebrew-calendar-holidays (hebrew 11 15 "Tu B'Shevat")) (if all-hebrew-calendar-holidays (hebrew 11 (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y 1) (let* ((h-year (extract-calendar-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))))) (s-s (calendar-hebrew-from-absolute (if (= (% (calendar-absolute-from-hebrew (list 7 1 h-year)) 7) 6) (calendar-dayname-on-or-before 6 (calendar-absolute-from-hebrew (list 11 17 h-year))) (calendar-dayname-on-or-before 6 (calendar-absolute-from-hebrew (list 11 16 h-year)))))) (day (extract-calendar-day s-s))) day)) "Shabbat Shirah")) (passover-etc) (if (and all-hebrew-calendar-holidays (let* ((m displayed-month) (y displayed-year) (year)) (increment-calendar-month m y -1) (let ((year (extract-calendar-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m 1 y)))))) (= 21 (% year 28))))) (julian 3 26 "Kiddush HaHamah")) (if all-hebrew-calendar-holidays (tisha-b-av-etc)))) "\ *Jewish holidays. See the documentation for `calendar-holidays' for details.") ! (defvar christian-holidays (quote ((if all-christian-calendar-holidays (fixed 1 6 "Epiphany")) (easter-etc) (if all-christian-calendar-holidays (greek-orthodox-easter)) (if all-christian-calendar-holidays (fixed 8 15 "Assumption")) (if all-christian-calendar-holidays (advent)) (fixed 12 25 "Christmas") (if all-christian-calendar-holidays (julian 12 25 "Eastern Orthodox Christmas")))) "\ *Christian holidays. See the documentation for `calendar-holidays' for details.") ! (defvar islamic-holidays (quote ((islamic 1 1 (format "Islamic New Year %d" (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y 1) (extract-calendar-year (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))))))) (if all-islamic-calendar-holidays (islamic 1 10 "Ashura")) (if all-islamic-calendar-holidays (islamic 3 12 "Mulad-al-Nabi")) (if all-islamic-calendar-holidays (islamic 7 26 "Shab-e-Mi'raj")) (if all-islamic-calendar-holidays (islamic 8 15 "Shab-e-Bara't")) (islamic 9 1 "Ramadan Begins") (if all-islamic-calendar-holidays (islamic 9 27 "Shab-e Qadr")) (if all-islamic-calendar-holidays (islamic 10 1 "Id-al-Fitr")) (if all-islamic-calendar-holidays (islamic 12 10 "Id-al-Adha")))) "\ *Islamic holidays. See the documentation for `calendar-holidays' for details.") ! (defvar solar-holidays (quote ((if (fboundp (quote atan)) (solar-equinoxes-solstices)) (sexp (eval calendar-daylight-savings-starts) "Daylight Savings Time Begins") (sexp (eval calendar-daylight-savings-ends) "Daylight Savings Time Ends"))) "\ *Sun-related holidays. See the documentation for `calendar-holidays' for details.") - (defvar calendar-holidays (quote (append general-holidays local-holidays other-holidays christian-holidays hebrew-holidays islamic-holidays solar-holidays)) "\ - *List of notable days for the command M-x holidays. - - Additional holidays are easy to add to the list, just put them in the list - `other-holidays' in your .emacs file. Similarly, by setting any of - `general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays', - `islamic-holidays', or `solar-holidays' to nil in your .emacs file, you can - eliminate unwanted categories of holidays. The intention is that (in the US) - `local-holidays' be set in site-init.el and `other-holidays' be set by the - user. - - The possible holiday-forms are as follows: - - (fixed MONTH DAY STRING) a fixed date on the Gregorian calendar - (float MONTH DAYNAME K STRING) the Kth DAYNAME in MONTH on the Gregorian - calendar (0 for Sunday, etc.); K<0 means - count back from the end of the month - (hebrew MONTH DAY STRING) a fixed date on the Hebrew calendar - (islamic MONTH DAY STRING) a fixed date on the Islamic calendar - (julian MONTH DAY STRING) a fixed date on the Julian calendar - (sexp SEXP STRING) SEXP is a Gregorian-date-valued expression - in the variable `year'; if it evaluates to - a visible date, that's the holiday; if it - evaluates to nil, there's no holiday - (if BOOLEAN HOLIDAY-FORM &optional HOLIDAY-FORM) gives a choice between - two holidays based on the value of BOOLEAN - (FUNCTION &optional ARGS) dates requiring special computation; ARGS, - if any, are passed in a list to the function - `calendar-holiday-function-FUNCTION' - - For example, to add Bastille Day, celebrated in France on July 14, add - - (fixed 7 14 \"Bastille Day\") - - to the list. To add Hurricane Supplication Day, celebrated in the Virgin - Islands on the fourth Monday in August, add - - (float 8 1 4 \"Hurricane Supplication Day\") - - to the list (the last Monday would be specified with `-1' instead of `4'). - To add the last day of Hanukkah to the list, use - - (hebrew 10 2 \"Last day of Hanukkah\") - - since the Hebrew months are numbered with 1 starting from Nisan, while to - add the Islamic feast celebrating Mohammed's birthday use - - (islamic 3 12 \"Mohammed's Birthday\") - - since the Islamic months are numbered from 1 starting with Muharram. To - add Thomas Jefferson's birthday, April 2, 1743 (Julian), use - - (julian 4 2 \"Jefferson's Birthday\") - - To include a holiday conditionally, use the if or the sexp form. For example, - to include American presidential elections, which occur on the first Tuesday - after the first Monday in November of years divisible by 4, add - - (sexp (if (zerop (% year 4)) - (calendar-gregorian-from-absolute - (1+ (calendar-dayname-on-or-before - 1 (+ 6 (calendar-absolute-from-gregorian - (list 11 1 year))))))) - \"US Presidential Election\") - - or - - (if (zerop (% displayed-year 4)) - (fixed 11 - (extract-calendar-day - (calendar-gregorian-from-absolute - (1+ (calendar-dayname-on-or-before - 1 (+ 6 (calendar-absolute-from-gregorian - (list 11 1 displayed-year))))))) - \"US Presidential Election\")) - - to the list. To include the phases of the moon, add - - (lunar-phases) - - to the holiday list, where `calendar-holiday-function-lunar-phases' is an - Emacs-Lisp function that you've written to return a (possibly empty) list of - the relevant VISIBLE dates with descriptive strings such as - - (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... ) - - The fixed, float, hebrew, islamic, julian, sexp, and if forms are implemented - by the inclusion of the functions `calendar-holiday-function-fixed', - `calendar-holiday-function-float', `calendar-holiday-function-hebrew', - `calendar-holiday-function-islamic', `calendar-holiday-function-julian', - `calendar-holiday-function-sexp', and `calendar-holiday-function-if', - respectively.") - (autoload (quote calendar) "calendar" "\ Display a three-month calendar in another window. --- 1431,1450 ---- See the documentation for `calendar-holidays' for details.") ! (defvar hebrew-holidays (quote ((holiday-rosh-hashanah-etc) (if all-hebrew-calendar-holidays (holiday-julian 11 (let* ((m displayed-month) (y displayed-year) (year)) (increment-calendar-month m y -1) (let ((year (extract-calendar-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m 1 y)))))) (if (zerop (% (1+ year) 4)) 22 21))) "\"Tal Umatar\" (evening)")) (if all-hebrew-calendar-holidays (holiday-hanukkah) (holiday-hebrew 9 25 "Hanukkah")) (if all-hebrew-calendar-holidays (holiday-hebrew 10 (let ((h-year (extract-calendar-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (list displayed-month 28 displayed-year)))))) (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year)) 7) 6) 11 10)) "Tzom Teveth")) (if all-hebrew-calendar-holidays (holiday-hebrew 11 15 "Tu B'Shevat")) (if all-hebrew-calendar-holidays (holiday-hebrew 11 (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y 1) (let* ((h-year (extract-calendar-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))))) (s-s (calendar-hebrew-from-absolute (if (= (% (calendar-absolute-from-hebrew (list 7 1 h-year)) 7) 6) (calendar-dayname-on-or-before 6 (calendar-absolute-from-hebrew (list 11 17 h-year))) (calendar-dayname-on-or-before 6 (calendar-absolute-from-hebrew (list 11 16 h-year)))))) (day (extract-calendar-day s-s))) day)) "Shabbat Shirah")) (holiday-passover-etc) (if (and all-hebrew-calendar-holidays (let* ((m displayed-month) (y displayed-year) (year)) (increment-calendar-month m y -1) (let ((year (extract-calendar-year (calendar-julian-from-absolute (calendar-absolute-from-gregorian (list m 1 y)))))) (= 21 (% year 28))))) (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.") ! (defvar christian-holidays (quote ((if all-christian-calendar-holidays (holiday-fixed 1 6 "Epiphany")) (holiday-easter-etc) (if all-christian-calendar-holidays (holiday-greek-orthodox-easter)) (if all-christian-calendar-holidays (holiday-fixed 8 15 "Assumption")) (if all-christian-calendar-holidays (holiday-advent)) (holiday-fixed 12 25 "Christmas") (if all-christian-calendar-holidays (holiday-julian 12 25 "Eastern Orthodox Christmas")))) "\ *Christian holidays. See the documentation for `calendar-holidays' for details.") ! (defvar islamic-holidays (quote ((holiday-islamic 1 1 (format "Islamic New Year %d" (let ((m displayed-month) (y displayed-year)) (increment-calendar-month m y 1) (extract-calendar-year (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (list m (calendar-last-day-of-month m y) y))))))) (if all-islamic-calendar-holidays (holiday-islamic 1 10 "Ashura")) (if all-islamic-calendar-holidays (holiday-islamic 3 12 "Mulad-al-Nabi")) (if all-islamic-calendar-holidays (holiday-islamic 7 26 "Shab-e-Mi'raj")) (if all-islamic-calendar-holidays (holiday-islamic 8 15 "Shab-e-Bara't")) (holiday-islamic 9 1 "Ramadan Begins") (if all-islamic-calendar-holidays (holiday-islamic 9 27 "Shab-e Qadr")) (if all-islamic-calendar-holidays (holiday-islamic 10 1 "Id-al-Fitr")) (if all-islamic-calendar-holidays (holiday-islamic 12 10 "Id-al-Adha")))) "\ *Islamic holidays. See the documentation for `calendar-holidays' for details.") ! (defvar solar-holidays (quote ((if (fboundp (quote atan)) (solar-equinoxes-solstices)) (progn (require (quote cal-dst)) (funcall (quote holiday-sexp) calendar-daylight-savings-starts (quote (format "Daylight Savings Time Begins %s" (if (fboundp (quote atan)) (solar-time-string (/ calendar-daylight-savings-switchover-time (float 60)) date (quote standard)) ""))))) (funcall (quote holiday-sexp) calendar-daylight-savings-ends (quote (format "Daylight Savings Time Ends %s" (if (fboundp (quote atan)) (solar-time-string (/ (- calendar-daylight-savings-switchover-time calendar-daylight-time-offset) (float 60)) date (quote daylight)) "")))))) "\ *Sun-related holidays. See the documentation for `calendar-holidays' for details.") (autoload (quote calendar) "calendar" "\ Display a three-month calendar in another window. *************** *** 1609,1615 **** (autoload (quote list-yahrzeit-dates) "calendar" "\ ! List of Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to ! END-YEAR. When called interactively from the calendar window, ! the date of death is taken from the cursor position." t nil) ;;;*** --- 1495,1501 ---- (autoload (quote list-yahrzeit-dates) "calendar" "\ ! List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR. ! When called interactively from the calendar window, the date of death is taken ! from the cursor position." t nil) ;;;*** *************** *** 1683,1687 **** ;;;*** ! ;;;### (autoloads (make-comint) "comint" "comint.el" (11285 51131)) ;;; Generated autoloads from comint.el --- 1569,1573 ---- ;;;*** ! ;;;### (autoloads (make-comint) "comint" "comint.el" (11335 3957)) ;;; Generated autoloads from comint.el *************** *** 1695,1699 **** ;;;*** ! ;;;### (autoloads (compare-windows) "compare-w" "compare-w.el" (11181 53258)) ;;; Generated autoloads from compare-w.el --- 1581,1585 ---- ;;;*** ! ;;;### (autoloads (compare-windows) "compare-w" "compare-w.el" (11330 25785)) ;;; Generated autoloads from compare-w.el *************** *** 1709,1713 **** ;;;*** ! ;;;### (autoloads (next-error grep compile) "compile" "compile.el" (11286 57626)) ;;; Generated autoloads from compile.el --- 1595,1599 ---- ;;;*** ! ;;;### (autoloads (next-error grep compile) "compile" "compile.el" (11332 51733)) ;;; Generated autoloads from compile.el *************** *** 1783,1788 **** ;;;*** ! ;;;### (autoloads (c++-mode) "cplus-md" "/home/fsf/rms/e19/lisp/cplus-md.el" (11296 5913)) ! ;;; Generated autoloads from /home/fsf/rms/e19/lisp/cplus-md.el (autoload (quote c++-mode) "cplus-md" "\ --- 1669,1674 ---- ;;;*** ! ;;;### (autoloads (c++-mode) "cplus-md" "cplus-md.el" (11296 5913)) ! ;;; Generated autoloads from cplus-md.el (autoload (quote c++-mode) "cplus-md" "\ *************** *** 1921,1925 **** ;;;*** ! ;;;### (autoloads (diary) "diary" "diary.el" (11176 61361)) ;;; Generated autoloads from diary.el --- 1807,1811 ---- ;;;*** ! ;;;### (autoloads (diary) "diary" "diary.el" (11300 39849)) ;;; Generated autoloads from diary.el *************** *** 1932,1936 **** ;;;*** ! ;;;### (autoloads (diff-backup diff) "diff" "diff.el" (11276 57004)) ;;; Generated autoloads from diff.el --- 1818,1822 ---- ;;;*** ! ;;;### (autoloads (diff-backup diff) "diff" "diff.el" (11302 33003)) ;;; Generated autoloads from diff.el *************** *** 1949,1953 **** ;;;*** ! ;;;### (autoloads (dired-hide-all dired-hide-subdir dired-tree-down dired-tree-up dired-kill-subdir dired-mark-subdir-files dired-goto-subdir dired-prev-subdir dired-maybe-insert-subdir dired-downcase dired-upcase dired-do-symlink-regexp dired-do-hardlink-regexp dired-do-copy-regexp dired-do-rename-regexp dired-do-rename dired-do-hardlink dired-do-symlink dired-do-copy dired-create-directory dired-string-replace-match dired-do-redisplay dired-do-load dired-do-byte-compile dired-do-compress dired-do-kill-lines dired-do-shell-command dired-do-print dired-do-chown dired-do-chgrp dired-do-chmod dired-backup-diff dired-diff) "dired-aux" "dired-aux.el" (11285 51153)) ;;; Generated autoloads from dired-aux.el --- 1835,1839 ---- ;;;*** ! ;;;### (autoloads (dired-hide-all dired-hide-subdir dired-tree-down dired-tree-up dired-kill-subdir dired-mark-subdir-files dired-goto-subdir dired-prev-subdir dired-maybe-insert-subdir dired-downcase dired-upcase dired-do-symlink-regexp dired-do-hardlink-regexp dired-do-copy-regexp dired-do-rename-regexp dired-do-rename dired-do-hardlink dired-do-symlink dired-do-copy dired-create-directory dired-string-replace-match dired-do-redisplay dired-do-load dired-do-byte-compile dired-do-compress dired-do-kill-lines dired-do-shell-command dired-do-print dired-do-chown dired-do-chgrp dired-do-chmod dired-backup-diff dired-diff) "dired-aux" "dired-aux.el" (11315 32230)) ;;; Generated autoloads from dired-aux.el *************** *** 2125,2129 **** ;;;*** ! ;;;### (autoloads (dired-noselect dired-other-frame dired-other-window dired) "dired" "dired.el" (11293 33078)) ;;; Generated autoloads from dired.el --- 2011,2015 ---- ;;;*** ! ;;;### (autoloads (dired-noselect dired-other-frame dired-other-window dired) "dired" "dired.el" (11330 12951)) ;;; Generated autoloads from dired.el *************** *** 2286,2289 **** --- 2172,2183 ---- ;;;*** + ;;;### (autoloads (dunnet) "dunnet" "dunnet.el" (11331 7826)) + ;;; Generated autoloads from dunnet.el + + (autoload (quote dunnet) "dunnet" "\ + Switch to *dungeon* buffer and start game." t nil) + + ;;;*** + ;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el" (11189 17403)) ;;; Generated autoloads from ebuff-menu.el *************** *** 2824,2827 **** --- 2718,2765 ---- ;;;*** + ;;;### (autoloads (font-lock-mode) "font-lock" "/home/fsf/rms/e19/lisp/font-lock.el" (11325 54485)) + ;;; Generated autoloads from /home/fsf/rms/e19/lisp/font-lock.el + + (defvar font-lock-mode-hook nil "\ + Function or functions to run on entry to Font Lock mode.") + + (autoload (quote font-lock-mode) "font-lock" "\ + Toggle Font Lock mode. + With arg, turn Font Lock mode on if and only if arg is positive. + + When Font Lock mode is enabled, text is fontified as you type it: + + - comments are displayed in `font-lock-comment-face'; + (That is a variable whose value should be a face name.) + - strings are displayed in `font-lock-string-face'; + - documentation strings are displayed in `font-lock-doc-string-face'; + - function and variable names in their defining forms are displayed + in `font-lock-function-name-face'; + - and certain other expressions are displayed in other faces + according to the value of the variable `font-lock-keywords'. + + When you turn Font Lock mode on/off, the buffer is fontified/defontified. + To fontify a buffer without having newly typed text become fontified, you + can use \\[font-lock-fontify-buffer]." t nil) + + ;;;*** + + ;;;### (autoloads (forms-find-file-other-window forms-find-file forms-mode) "forms" "forms.el" (11336 20307)) + ;;; Generated autoloads from forms.el + + (autoload (quote forms-mode) "forms" "\ + Major mode to visit files in a field-structured manner using a form. + + Commands (prefix with C-c if not in read-only mode): + \\{forms-mode-map}" t nil) + + (autoload (quote forms-find-file) "forms" "\ + Visit a file in Forms mode." t nil) + + (autoload (quote forms-find-file-other-window) "forms" "\ + Visit a file in Forms mode in other window." t nil) + + ;;;*** + ;;;### (autoloads (fortran-mode) "fortran" "fortran.el" (11285 51227)) ;;; Generated autoloads from fortran.el *************** *** 2904,2908 **** ;;;*** ! ;;;### (autoloads (gnus) "gnus" "gnus.el" (11289 23134)) ;;; Generated autoloads from gnus.el --- 2842,2846 ---- ;;;*** ! ;;;### (autoloads (gnus) "gnus" "gnus.el" (11336 19282)) ;;; Generated autoloads from gnus.el *************** *** 2953,2957 **** ;;;*** ! ;;;### (autoloads (xdb dbx sdb gdb) "gud" "gud.el" (11294 14606)) ;;; Generated autoloads from gud.el --- 2891,2895 ---- ;;;*** ! ;;;### (autoloads (xdb dbx sdb gdb) "gud" "gud.el" (11332 46975)) ;;; Generated autoloads from gud.el *************** *** 2981,2985 **** ;;;*** ! ;;;### (autoloads (hanoi) "hanoi" "hanoi.el" (11285 51253)) ;;; Generated autoloads from hanoi.el --- 2919,2923 ---- ;;;*** ! ;;;### (autoloads (hanoi) "hanoi" "hanoi.el" (11324 28709)) ;;; Generated autoloads from hanoi.el *************** *** 3000,3004 **** ;;;*** ! ;;;### (autoloads (hexl-find-file hexl-mode) "hexl" "hexl.el" (11270 30440)) ;;; Generated autoloads from hexl.el --- 2938,2942 ---- ;;;*** ! ;;;### (autoloads (hexl-find-file hexl-mode) "hexl" "hexl.el" (11319 6522)) ;;; Generated autoloads from hexl.el *************** *** 3128,3131 **** --- 3066,3101 ---- ;;;*** + ;;;### (autoloads (make-hippie-expand-function hippie-expand) "hippie-exp" "hippie-exp.el" (11336 59237)) + ;;; Generated autoloads from hippie-exp.el + + (defvar hippie-expand-try-functions-list (quote (try-complete-file-name try-expand-all-abbrevs try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-complete-lisp-symbol)) "\ + The list of expansion functions tried in order by `hippie-expand'. + To change the behavior of `hippie-expand', remove, change the order of, + or insert functions in this list.") + + (defvar hippie-expand-verbose t "\ + *Non-nil makes `hippie-expand' output which function it is trying.") + + (defvar hippie-expand-max-buffers nil "\ + *The maximum number of buffers (apart from the current) searched. + If nil, all buffers are searched.") + + (autoload (quote hippie-expand) "hippie-exp" "\ + Try to expand text before point, using multiple methods. + The expansion functions in `hippie-expand-try-functions-list' are + tried in order, until a possible expansion is found. Repeated + application of `hippie-expand' inserts successively possible + expansions. + With a positive numeric argument, jumps directly to the ARG next + function in this list. With a negative argument or just \\[universal-argument], + undoes the expansion." t nil) + + (autoload (quote make-hippie-expand-function) "hippie-exp" "\ + Construct a function similar to `hippie-expand'. + Make it use the expansion functions in TRY-LIST. An optional second + argument VERBOSE non-nil makes the function verbose." nil t) + + ;;;*** + ;;;### (autoloads (inferior-lisp) "inf-lisp" "inf-lisp.el" (11294 14427)) ;;; Generated autoloads from inf-lisp.el *************** *** 3180,3184 **** ;;;*** ! ;;;### (autoloads (Info-goto-emacs-key-command-node Info-goto-emacs-command-node info) "info" "info.el" (11284 6220)) ;;; Generated autoloads from info.el --- 3150,3154 ---- ;;;*** ! ;;;### (autoloads (Info-goto-emacs-key-command-node Info-goto-emacs-command-node info) "info" "info.el" (11299 35162)) ;;; Generated autoloads from info.el *************** *** 3231,3235 **** ;;;*** ! ;;;### (autoloads (ispell-region ispell-word ispell) "ispell" "ispell.el" (11291 62895)) ;;; Generated autoloads from ispell.el --- 3201,3205 ---- ;;;*** ! ;;;### (autoloads (ispell-region ispell-word ispell) "ispell" "ispell.el" (11332 65354)) ;;; Generated autoloads from ispell.el *************** *** 3344,3348 **** ;;;*** ! ;;;### (autoloads (phases-of-moon) "lunar" "lunar.el" (11176 61371)) ;;; Generated autoloads from lunar.el --- 3314,3318 ---- ;;;*** ! ;;;### (autoloads (phases-of-moon) "lunar" "lunar.el" (11298 18264)) ;;; Generated autoloads from lunar.el *************** *** 3436,3440 **** ;;;*** ! ;;;### (autoloads nil "mail-utils" "mail-utils.el" (11267 45112)) ;;; Generated autoloads from mail-utils.el --- 3406,3410 ---- ;;;*** ! ;;;### (autoloads nil "mail-utils" "mail-utils.el" (11323 3305)) ;;; Generated autoloads from mail-utils.el *************** *** 3446,3450 **** ;;;*** ! ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup) "mailabbrev" "mailabbrev.el" (11294 13814)) ;;; Generated autoloads from mailabbrev.el --- 3416,3420 ---- ;;;*** ! ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup) "mailabbrev" "mailabbrev.el" (11324 36346)) ;;; Generated autoloads from mailabbrev.el *************** *** 3564,3581 **** ;;;*** ! ;;;### (autoloads (manual-entry) "man" "man.el" (11291 27435)) ;;; Generated autoloads from man.el (autoload (quote manual-entry) "man" "\ Get a Un*x manual page and put it in a buffer. ! This command is the top-level command in the man package. It runs a Un*x command to retrieve and clean a manpage in the background and places the ! results in a Man-mode (manpage browsing) buffer. See variable ! Man-notify for what happens when the buffer is ready. ! Universal argument ARG, is passed to Man-getpage-in-background." t nil) ;;;*** ! ;;;### (autoloads (map-y-or-n-p) "map-ynp" "map-ynp.el" (11253 12506)) ;;; Generated autoloads from map-ynp.el --- 3534,3551 ---- ;;;*** ! ;;;### (autoloads (manual-entry) "man" "man.el" (11321 63369)) ;;; Generated autoloads from man.el (autoload (quote manual-entry) "man" "\ Get a Un*x manual page and put it in a buffer. ! This command is the top-level command in the man package. It runs a Un*x command to retrieve and clean a manpage in the background and places the ! results in a Man mode (manpage browsing) buffer. See variable ! `Man-notify' for what happens when the buffer is ready. ! Universal argument ARG, is passed to `Man-getpage-in-background'." t nil) ;;;*** ! ;;;### (autoloads (map-y-or-n-p) "map-ynp" "map-ynp.el" (11319 45784)) ;;; Generated autoloads from map-ynp.el *************** *** 3622,3626 **** ;;;*** ! ;;;### (autoloads (mh-smail mh-rmail) "mh-e" "mh-e.el" (11285 53112)) ;;; Generated autoloads from mh-e.el --- 3592,3596 ---- ;;;*** ! ;;;### (autoloads (mh-smail mh-rmail) "mh-e" "mh-e.el" (11335 17728)) ;;; Generated autoloads from mh-e.el *************** *** 3725,3729 **** ;;;*** ! ;;;### (autoloads (outline-minor-mode outline-mode) "outline" "outline.el" (11282 47668)) ;;; Generated autoloads from outline.el --- 3695,3699 ---- ;;;*** ! ;;;### (autoloads (outline-minor-mode outline-mode) "outline" "outline.el" (11319 20136)) ;;; Generated autoloads from outline.el *************** *** 4024,4033 **** ;;;*** ! ;;;### (autoloads (rmail-input rmail-mode rmail) "rmail" "rmail.el" (11288 623)) ;;; Generated autoloads from rmail.el (defvar rmail-dont-reply-to-names nil "\ *A regexp specifying names to prune of reply to messages. ! nil means dont reply to yourself.") (defvar rmail-default-dont-reply-to-names "info-" "\ --- 3994,4003 ---- ;;;*** ! ;;;### (autoloads (rmail-input rmail-mode rmail) "rmail" "rmail.el" (11334 11170)) ;;; Generated autoloads from rmail.el (defvar rmail-dont-reply-to-names nil "\ *A regexp specifying names to prune of reply to messages. ! A value of nil means exclude your own name only.") (defvar rmail-default-dont-reply-to-names "info-" "\ *************** *** 4036,4040 **** `rmail-dont-reply-to-names' explicitly. (The other part of the default value is the user's name.) ! It is useful to set this variable in the site customisation file.") (defvar rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^message-id:\\|^summary-line:" "\ --- 4006,4010 ---- `rmail-dont-reply-to-names' explicitly. (The other part of the default value is the user's name.) ! It is useful to set this variable in the site customization file.") (defvar rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^message-id:\\|^summary-line:" "\ *************** *** 4050,4053 **** --- 4020,4026 ---- and the value of the environment variable MAIL overrides it).") + (defvar rmail-mail-new-frame nil "\ + *Non-nil means Rmail makes a new frame for composing outgoing mail.") + (autoload (quote rmail) "rmail" "\ Read and edit incoming mail. *************** *** 4120,4124 **** ;;;*** ! ;;;### (autoloads (sc-cite-original) "sc" "sc.el" (11285 51468)) ;;; Generated autoloads from sc.el --- 4093,4097 ---- ;;;*** ! ;;;### (autoloads (sc-cite-original) "sc" "sc.el" (11297 261)) ;;; Generated autoloads from sc.el *************** *** 4190,4194 **** ;;;*** ! ;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode) "sendmail" "sendmail.el" (11281 27134)) ;;; Generated autoloads from sendmail.el --- 4163,4167 ---- ;;;*** ! ;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode) "sendmail" "sendmail.el" (11334 11290)) ;;; Generated autoloads from sendmail.el *************** *** 4284,4288 **** ;;;*** ! ;;;### (autoloads (server-start) "server" "server.el" (11294 22183)) ;;; Generated autoloads from server.el --- 4257,4261 ---- ;;;*** ! ;;;### (autoloads (server-start) "server" "server.el" (11332 54913)) ;;; Generated autoloads from server.el *************** *** 4308,4320 **** ;;;*** ! ;;;### (autoloads (shell) "shell" "shell.el" (11275 52454)) ;;; Generated autoloads from shell.el ! (defvar shell-prompt-pattern "^[^#$%>]*[#$%>] *" "\ Regexp to match prompts in the inferior shell. ! Defaults to \"^[^#$%>]*[#$%>] *\", which works pretty well. This variable is used to initialise `comint-prompt-regexp' in the shell buffer. This is a fine thing to set in your `.emacs' file.") --- 4281,4298 ---- ;;;*** ! ;;;### (autoloads (shell) "shell" "shell.el" (11336 59243)) ;;; Generated autoloads from shell.el ! (defvar shell-prompt-pattern "^[^#$%> ! ]*[#$%>] *" "\ Regexp to match prompts in the inferior shell. ! Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well. This variable is used to initialise `comint-prompt-regexp' in the shell buffer. + The pattern should probably not match more than one line. If it does, + shell-mode may become confused trying to distinguish prompt from input + on lines which don't start with a prompt. + This is a fine thing to set in your `.emacs' file.") *************** *** 4343,4349 **** ;;;*** ! ;;;### (autoloads (sunrise-sunset) "solar" "solar.el" (11292 39058)) ;;; Generated autoloads from solar.el (autoload (quote sunrise-sunset) "solar" "\ Local time of sunrise and sunset for today. Accurate to +/- 2 minutes. --- 4321,4361 ---- ;;;*** ! ;;;### (autoloads (sunrise-sunset) "solar" "solar.el" (11310 32522)) ;;; Generated autoloads from solar.el + (defvar calendar-time-display-form (quote (12-hours ":" minutes am-pm (if time-zone " (") time-zone (if time-zone ")"))) "\ + *The pseudo-pattern that governs the way a time of day is formatted. + + A pseudo-pattern is a list of expressions that can involve the keywords + `12-hours', `24-hours', and `minutes', all numbers in string form, + and `am-pm' and `time-zone', both alphabetic strings. + + For example, the form + + '(24-hours \":\" minutes + (if time-zone \" (\") time-zone (if time-zone \")\")) + + would give military-style times like `21:07 (UTC)'.") + + (defvar calendar-latitude nil "\ + *Latitude of `calendar-location-name' in degrees, + north, - south. + For example, 40.7 for New York City. + It may not be a good idea to set this in advance for your site; + if there may be users running Emacs at your site + who are physically located elsewhere, they would get the wrong + value and might not know how to override it.") + + (defvar calendar-longitude nil "\ + *Longitude of `calendar-location-name' in degrees, + east, - west. + For example, -74.0 for New York City. + It may not be a good idea to set this in advance for your site; + if there may be users running Emacs at your site + who are physically located elsewhere, they would get the wrong + value and might not know how to override it.") + + (defvar calendar-location-name (quote (let ((float-output-format "%.1f")) (format "%s%s, %s%s" (abs calendar-latitude) (if (> calendar-latitude 0) "N" "S") (abs calendar-longitude) (if (> calendar-longitude 0) "E" "W")))) "\ + *Expression evaluating to name of `calendar-longitude', calendar-latitude'. + Default value is just the latitude, longitude pair.") + (autoload (quote sunrise-sunset) "solar" "\ Local time of sunrise and sunset for today. Accurate to +/- 2 minutes. *************** *** 4462,4466 **** ;;;*** ! ;;;### (autoloads (spook) "spook" "spook.el" (11274 56066)) ;;; Generated autoloads from spook.el --- 4474,4478 ---- ;;;*** ! ;;;### (autoloads (snarf-spooks spook) "spook" "spook.el" (11332 39077)) ;;; Generated autoloads from spook.el *************** *** 4468,4471 **** --- 4480,4486 ---- Adds that special touch of class to your outgoing mail." t nil) + (autoload (quote snarf-spooks) "spook" "\ + Return a vector containing the lines from `spook-phrases-file'." nil nil) + ;;;*** *************** *** 4489,4493 **** ;;;*** ! ;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (11275 52507)) ;;; Generated autoloads from tar-mode.el --- 4504,4508 ---- ;;;*** ! ;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (11336 20101)) ;;; Generated autoloads from tar-mode.el *************** *** 4755,4759 **** ;;;*** ! ;;;### (autoloads (texinfo-mode) "texinfo" "texinfo.el" (11283 53395)) ;;; Generated autoloads from texinfo.el --- 4770,4774 ---- ;;;*** ! ;;;### (autoloads (texinfo-mode) "texinfo" "texinfo.el" (11336 13830)) ;;; Generated autoloads from texinfo.el *************** *** 4765,4770 **** These are files that are used as input for TeX to make printed manuals ! and also to be turned into Info files by \\[texinfo-format-buffer] or ! `makeinfo'. These files must be written in a very restricted and modified version of TeX input format. --- 4780,4785 ---- These are files that are used as input for TeX to make printed manuals ! and also to be turned into Info files with \\[makeinfo-buffer] or ! the `makeinfo' program. These files must be written in a very restricted and modified version of TeX input format. *************** *** 4772,4777 **** set up so expression commands skip Texinfo bracket groups. To see what the Info version of a region of the Texinfo file will look like, ! use \\[texinfo-format-region]. This command runs Info on the current region ! of the Texinfo file and formats it properly. You can show the structure of a Texinfo file with \\[texinfo-show-structure]. --- 4787,4791 ---- set up so expression commands skip Texinfo bracket groups. To see what the Info version of a region of the Texinfo file will look like, ! use \\[makeinfo-region], which runs `makeinfo' on the current region. You can show the structure of a Texinfo file with \\[texinfo-show-structure]. *************** *** 4828,4832 **** ;;;*** ! ;;;### (autoloads (display-time) "time" "time.el" (11279 41068)) ;;; Generated autoloads from time.el --- 4842,4846 ---- ;;;*** ! ;;;### (autoloads (display-time) "time" "time.el" (11322 20891)) ;;; Generated autoloads from time.el *************** *** 5095,5099 **** ;;;*** ! ;;;### (autoloads (vc-update-change-log vc-cancel-version vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory vc-insert-headers vc-diff vc-register vc-next-action) "vc" "vc.el" (11289 15564)) ;;; Generated autoloads from vc.el --- 5109,5113 ---- ;;;*** ! ;;;### (autoloads (vc-update-change-log vc-cancel-version vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory vc-insert-headers vc-diff vc-register vc-next-action) "vc" "vc.el" (11321 6270)) ;;; Generated autoloads from vc.el *************** *** 5172,5175 **** --- 5186,5190 ---- With prefix arg of C-u, only find log entries for the current buffer's file. With any numeric prefix arg, find log entries for all files currently visited. + Otherwise, find log entries for all registered files in the default directory. From a program, any arguments are passed to the `rcs2log' script." t nil) *************** *** 5226,5230 **** ;;;*** ! ;;;### (autoloads (view-mode view-buffer-other-window view-buffer view-file-other-window view-file) "view" "view.el" (11277 39824)) ;;; Generated autoloads from view.el --- 5241,5245 ---- ;;;*** ! ;;;### (autoloads (view-mode view-buffer-other-window view-buffer view-file-other-window view-file) "view" "view.el" (11336 19791)) ;;; Generated autoloads from view.el *************** *** 5237,5241 **** For list of all View commands, type ? or h while viewing. ! Calls the value of view-hook if that is non-nil." t nil) (autoload (quote view-file-other-window) "view" "\ --- 5252,5256 ---- For list of all View commands, type ? or h while viewing. ! This command runs the normal hook `view-hook'." t nil) (autoload (quote view-file-other-window) "view" "\ *************** *** 5248,5252 **** For list of all View commands, type ? or h while viewing. ! Calls the value of view-hook if that is non-nil." t nil) (autoload (quote view-buffer) "view" "\ --- 5263,5267 ---- For list of all View commands, type ? or h while viewing. ! This command runs the normal hook `view-hook'." t nil) (autoload (quote view-buffer) "view" "\ *************** *** 5258,5268 **** For list of all View commands, type ? or h while viewing. ! Calls the value of view-hook if that is non-nil." t nil) (autoload (quote view-buffer-other-window) "view" "\ View BUFFER in View mode in another window, ! returning to original buffer when done ONLY if ! prefix argument not-return is nil (as by default). ! The usual Emacs commands are not available; instead, a special set of commands (mostly letters and punctuation) are defined for moving around in the buffer. --- 5273,5284 ---- For list of all View commands, type ? or h while viewing. ! This command runs the normal hook `view-hook'." t nil) (autoload (quote view-buffer-other-window) "view" "\ View BUFFER in View mode in another window, ! returning to original buffer when done *only* if ! prefix argument NOT-RETURN is nil (which is the default). ! ! The usual Emacs commands are not available in View mode; instead, a special set of commands (mostly letters and punctuation) are defined for moving around in the buffer. *************** *** 5270,5274 **** For list of all View commands, type ? or h while viewing. ! Calls the value of view-hook if that is non-nil." t nil) (autoload (quote view-mode) "view" "\ --- 5286,5290 ---- For list of all View commands, type ? or h while viewing. ! This command runs the normal hook `view-hook'." t nil) (autoload (quote view-mode) "view" "\ *************** *** 5307,5311 **** q or C-c exit view-mode and return to previous buffer. ! Entry to this mode calls the value of view-hook if non-nil. \\{view-mode-map}" nil nil) --- 5323,5328 ---- q or C-c exit view-mode and return to previous buffer. ! Entry to this mode runs the normal hook `view-hook'. ! \\{view-mode-map}" nil nil) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/mail-utils.el emacs-19.17/lisp/mail-utils.el *** emacs-19.16/lisp/mail-utils.el Wed May 26 14:00:24 1993 --- emacs-19.17/lisp/mail-utils.el Wed Jul 7 13:50:33 1993 *************** *** 212,215 **** --- 212,230 ---- (substring labels (match-end 0)))))) labels) + + (defun mail-rfc822-time-zone (time) + (let* ((sec (or (car (current-time-zone time)) 0)) + (absmin (/ (abs sec) 60))) + (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60)))) + + (defun mail-rfc822-date () + (let* ((time (current-time)) + (s (current-time-string time))) + (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s) + (concat (substring s (match-beginning 2) (match-end 2)) " " + (substring s (match-beginning 1) (match-end 1)) " " + (substring s (match-beginning 4) (match-end 4)) " " + (substring s (match-beginning 3) (match-end 3)) " " + (mail-rfc822-time-zone time)))) (provide 'mail-utils) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/mailabbrev.el emacs-19.17/lisp/mailabbrev.el *** emacs-19.16/lisp/mailabbrev.el Thu Jul 1 16:24:57 1993 --- emacs-19.17/lisp/mailabbrev.el Thu Jul 8 17:13:30 1993 *************** *** 549,553 **** Don't use this command in Lisp programs! \(goto-char (point-max)) is faster and avoids clobbering the mark." ! (interactive "p") (if (looking-at "[ \t]*\n") (expand-abbrev)) (setq this-command 'end-of-buffer) --- 549,553 ---- Don't use this command in Lisp programs! \(goto-char (point-max)) is faster and avoids clobbering the mark." ! (interactive "P") (if (looking-at "[ \t]*\n") (expand-abbrev)) (setq this-command 'end-of-buffer) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/makeinfo.el emacs-19.17/lisp/makeinfo.el *** emacs-19.16/lisp/makeinfo.el Mon Jun 21 02:59:02 1993 --- emacs-19.17/lisp/makeinfo.el Sun Jul 18 03:49:10 1993 *************** *** 50,54 **** The name of the file is appended to this string, separated by a space.") ! (defvar makeinfo-options "+fill-column=70" "*String containing options for running `makeinfo'. Do not include `--footnote-style' or `--paragraph-indent'; --- 50,54 ---- The name of the file is appended to this string, separated by a space.") ! (defvar makeinfo-options "--fill-column=70" "*String containing options for running `makeinfo'. Do not include `--footnote-style' or `--paragraph-indent'; *************** *** 57,61 **** (require 'texinfo) - (require 'texinfmt) (defvar makeinfo-compilation-process nil --- 57,60 ---- diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/man.el emacs-19.17/lisp/man.el *** emacs-19.16/lisp/man.el Tue Jul 6 01:44:28 1993 --- emacs-19.17/lisp/man.el Tue Jul 6 18:07:05 1993 *************** *** 172,176 **** mode-line-buffer-identification " " global-mode-string ! Man-page-mode-string " %[(" mode-name minor-mode-alist mode-line-process ")%]----" (-3 . "%p") "-%-") --- 172,176 ---- mode-line-buffer-identification " " global-mode-string ! " " Man-page-mode-string " %[(" mode-name minor-mode-alist mode-line-process ")%]----" (-3 . "%p") "-%-") diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/menu-bar.el emacs-19.17/lisp/menu-bar.el *** emacs-19.16/lisp/menu-bar.el Fri Jul 2 17:36:25 1993 --- emacs-19.17/lisp/menu-bar.el Fri Jul 16 21:41:42 1993 *************** *** 26,29 **** --- 26,31 ---- (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")) (defvar menu-bar-help-menu (make-sparse-keymap "Help")) + ;; Put Help item last. + (setq menu-bar-final-items '(help)) (define-key global-map [menu-bar help] (cons "Help" menu-bar-help-menu)) (defvar menu-bar-edit-menu (make-sparse-keymap "Edit")) *************** *** 43,52 **** '("Save Buffer As..." . write-file)) (define-key menu-bar-file-menu [save-buffer] '("Save Buffer" . save-buffer)) (define-key menu-bar-file-menu [open-file] '("Open File..." . find-file)) (define-key menu-bar-file-menu [new-frame] '("New Frame" . new-frame)) (define-key menu-bar-edit-menu [fill] '("Fill" . fill-region)) (define-key menu-bar-edit-menu [clear] '("Clear" . delete-region)) ! (define-key menu-bar-edit-menu [choose-selection] '("Choose Next Paste" . mouse-menu-choose-yank)) (define-key menu-bar-edit-menu [paste] '("Paste" . yank)) --- 45,57 ---- '("Save Buffer As..." . write-file)) (define-key menu-bar-file-menu [save-buffer] '("Save Buffer" . save-buffer)) + (define-key menu-bar-file-menu [dired] '("Open Directory..." . dired)) (define-key menu-bar-file-menu [open-file] '("Open File..." . find-file)) (define-key menu-bar-file-menu [new-frame] '("New Frame" . new-frame)) + + (define-key menu-bar-edit-menu [spell] '("Spell..." . ispell-menu-map)) (define-key menu-bar-edit-menu [fill] '("Fill" . fill-region)) (define-key menu-bar-edit-menu [clear] '("Clear" . delete-region)) ! (define-key menu-bar-edit-menu [choose-next-paste] '("Choose Next Paste" . mouse-menu-choose-yank)) (define-key menu-bar-edit-menu [paste] '("Paste" . yank)) *************** *** 64,67 **** --- 69,74 ---- (consp buffer-undo-list))) + (autoload 'ispell-menu-map "ispell" nil t 'keymap) + (define-key menu-bar-help-menu [emacs-tutorial] '("Emacs Tutorial" . help-with-tutorial)) *************** *** 97,101 **** (put 'save-buffer 'menu-enable '(buffer-modified-p)) ! (put 'revert-buffer 'menu-enable '(and (buffer-modified-p) (buffer-file-name))) (put 'delete-frame 'menu-enable '(cdr (visible-frame-list))) (put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p)) --- 104,111 ---- (put 'save-buffer 'menu-enable '(buffer-modified-p)) ! (put 'revert-buffer 'menu-enable ! '(or revert-buffer-function revert-buffer-insert-file-contents-function ! (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)) *************** *** 127,131 **** (arg (x-popup-menu event (list "Yank Menu" ! (cons "Pick Selection" menu))))) ;; A mouse click outside the menu returns nil. ;; Avoid a confusing error from passing nil to rotate-yank-pointer. --- 137,141 ---- (arg (x-popup-menu event (list "Yank Menu" ! (cons "Choose Next Yank" menu))))) ;; A mouse click outside the menu returns nil. ;; Avoid a confusing error from passing nil to rotate-yank-pointer. *************** *** 198,202 **** (setq tail (cdr tail))) (nconc (reverse head) ! (list (cons (concat (make-string (- (/ maxlen 2) 8) ?\ ) "List All Buffers") 'list-buffers))))))) --- 208,212 ---- (setq tail (cdr tail))) (nconc (reverse head) ! (list (cons (concat (make-string (max 0 (- (/ maxlen 2) 8)) ?\ ) "List All Buffers") 'list-buffers))))))) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/mh-e.el emacs-19.17/lisp/mh-e.el *** emacs-19.16/lisp/mh-e.el Sun Jun 20 18:45:17 1993 --- emacs-19.17/lisp/mh-e.el Fri Jul 16 20:18:08 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.13 1993/06/20 22:45:13 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.14 1993/07/17 00:18:04 rms Exp $") ;;; Code: *************** *** 100,104 **** (goto-char (point)) (or (bolp) (forward-line 1)) ! (while (< (point) (mark)) (insert mh-ins-string) (forward-line 1)))) --- 100,104 ---- (goto-char (point)) (or (bolp) (forward-line 1)) ! (while (< (point) (mark t)) (insert mh-ins-string) (forward-line 1)))) *************** *** 1410,1414 **** (erase-buffer) (mh-exec-cmd-output "mhpath" nil mh-draft-folder "new") ! (buffer-substring (point) (1- (mark))))) --- 1410,1414 ---- (erase-buffer) (mh-exec-cmd-output "mhpath" nil mh-draft-folder "new") ! (buffer-substring (point) (1- (mark t))))) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/mouse.el emacs-19.17/lisp/mouse.el *** emacs-19.16/lisp/mouse.el Fri Jul 2 19:14:39 1993 --- emacs-19.17/lisp/mouse.el Tue Jul 13 17:31:54 1993 *************** *** 841,844 **** --- 841,867 ---- ;;;!! ((= (current-column) (car relative-coordinate)) (ding)))))) + ;; Choose a completion with the mouse. + + (defun mouse-choose-completion (event) + (interactive "e") + (let (choice) + (save-excursion + (set-buffer (window-buffer (posn-window (event-start event)))) + (save-excursion + (goto-char (posn-point (event-start event))) + (skip-chars-backward "^ \t\n") + (let ((beg (point))) + (skip-chars-forward "^ \t\n") + (setq choice (buffer-substring beg (point)))))) + (save-excursion + (set-buffer (window-buffer (minibuffer-window))) + (goto-char (max (point-min) (- (point-max) (length choice)))) + (while (and (not (eobp)) + (let ((tail (buffer-substring (point) (point-max)))) + (not (string= tail (substring choice 0 (length tail)))))) + (forward-char 1)) + (insert choice) + (delete-region (point) (point-max))))) + ;; Font selection. diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/paren.el emacs-19.17/lisp/paren.el *** emacs-19.16/lisp/paren.el Tue Jul 6 04:53:02 1993 --- emacs-19.17/lisp/paren.el Fri Jul 16 14:35:23 1993 *************** *** 29,94 **** ;;; Code: (defvar show-paren-overlay nil) ;; Find the place to show, if there is one, ;; and show it until input arrives. (defun show-paren-command-hook () ! (let (pos dir mismatch (oldpos (point)) ! (face (if (face-equal 'highlight 'region) ! 'underline 'highlight))) ! (cond ((eq (char-syntax (following-char)) ?\() ! (setq dir 1)) ! ((eq (char-syntax (preceding-char)) ?\)) ! (setq dir -1))) ! (save-excursion ! (save-restriction ! ;; Determine the range within which to look for a match. ! (if blink-matching-paren-distance ! (narrow-to-region (max (point-min) ! (- (point) blink-matching-paren-distance)) ! (min (point-max) ! (+ (point) blink-matching-paren-distance)))) ! ;; Scan across one sexp within that range. ! (condition-case () ! (setq pos (scan-sexps (point) dir)) ! (error nil)) ! ;; See if the "matching" paren is the right kind of paren ! ;; to match the one we started at. ! (if pos ! (let ((beg (min pos oldpos)) (end (max pos oldpos))) ! (and (/= (char-syntax (char-after beg)) ?\$) ! (setq mismatch ! (/= (char-after (1- end)) ! (logand (lsh (aref (syntax-table) ! (char-after beg)) ! -8) ! 255)))))) ! ;; If they don't properly match, don't show. ! (if mismatch ! (progn ! (message "Paren mismatch") ! ;;; (setq pos nil) ! )))) ! (cond (pos ! (if show-paren-overlay ! (move-overlay show-paren-overlay (- pos dir) pos) ! (setq show-paren-overlay ! (make-overlay (- pos dir) pos))) ! (overlay-put show-paren-overlay 'face face) ! ;;; This is code to blink the highlighting. ! ;;; It is desirable to avoid this because ! ;;; it would interfere with auto-save and gc when idle. ! ;;; (while (sit-for 1) ! ;;; (overlay-put show-paren-overlay ! ;;; 'face ! ;;; (if (overlay-get show-paren-overlay ! ;;; 'face) ! ;;; nil face))) ! ) ! (t ! (and show-paren-overlay (overlay-buffer show-paren-overlay) ! (delete-overlay show-paren-overlay)))))) ! (add-hook 'post-command-hook 'show-paren-command-hook) (provide 'paren) --- 29,122 ---- ;;; Code: + ;; This is the overlay used to highlight the matching paren. (defvar show-paren-overlay nil) + ;; This is the overlay used to highlight the closeparen + ;; right before point. + (defvar show-paren-overlay-1 nil) + (defvar show-paren-mismatch-face nil) + ;; Find the place to show, if there is one, ;; and show it until input arrives. (defun show-paren-command-hook () ! (if window-system ! (let (pos dir mismatch (oldpos (point)) ! (face 'region)) ! (cond ((eq (char-syntax (following-char)) ?\() ! (setq dir 1)) ! ((eq (char-syntax (preceding-char)) ?\)) ! (setq dir -1))) ! (if dir ! (save-excursion ! (save-restriction ! ;; Determine the range within which to look for a match. ! (if blink-matching-paren-distance ! (narrow-to-region (max (point-min) ! (- (point) blink-matching-paren-distance)) ! (min (point-max) ! (+ (point) blink-matching-paren-distance)))) ! ;; Scan across one sexp within that range. ! (condition-case () ! (setq pos (scan-sexps (point) dir)) ! (error nil)) ! ;; See if the "matching" paren is the right kind of paren ! ;; to match the one we started at. ! (if pos ! (let ((beg (min pos oldpos)) (end (max pos oldpos))) ! (and (/= (char-syntax (char-after beg)) ?\$) ! (setq mismatch ! (/= (char-after (1- end)) ! (logand (lsh (aref (syntax-table) ! (char-after beg)) ! -8) ! 255)))))) ! ;; If they don't properly match, use a different face, ! ;; or print a message. ! (if mismatch ! (progn ! (and (null show-paren-mismatch-face) ! (x-display-color-p) ! (or (setq show-paren-mismatch-face ! (internal-find-face 'paren-mismatch)) ! (progn ! (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) ! (message "Paren mismatch")))) ! ))) ! (cond (pos ! (if (= dir -1) ! ;; If matching backwards, highlight the closeparen ! ;; before point as well as its matching open. ! (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))) ! (overlay-put show-paren-overlay-1 'face face)) ! ;; Otherwise, turn off any such highlighting. ! (and show-paren-overlay-1 ! (overlay-buffer show-paren-overlay-1) ! (delete-overlay show-paren-overlay-1))) ! ;; 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))) ! (overlay-put show-paren-overlay 'face face)) ! (t ! ;; If not at a paren that has a match, ! ;; turn off any previous paren highlighting. ! (and show-paren-overlay (overlay-buffer show-paren-overlay) ! (delete-overlay show-paren-overlay)) ! (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1) ! (delete-overlay show-paren-overlay-1))))))) ! (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.16/lisp/rmail.el emacs-19.17/lisp/rmail.el *** emacs-19.16/lisp/rmail.el Wed Jun 30 12:43:10 1993 --- emacs-19.17/lisp/rmail.el Fri Jul 16 00:16:34 1993 *************** *** 82,85 **** --- 82,89 ---- and the value of the environment variable MAIL overrides it).") + ;;;###autoload + (defvar rmail-mail-new-frame nil + "*Non-nil means Rmail makes a new frame for composing outgoing mail.") + ;; These may be altered by site-init.el to match the format of mmdf files ;; delimiting used on a given host (delim1 and delim2 from the config *************** *** 546,550 **** ;; Provide default set of inboxes for primary mail file ~/RMAIL. (and (null rmail-inbox-list) ! (equal buffer-file-name (expand-file-name rmail-file-name)) (setq rmail-inbox-list (or rmail-primary-inbox-list --- 550,555 ---- ;; Provide default set of inboxes for primary mail file ~/RMAIL. (and (null rmail-inbox-list) ! (or (equal buffer-file-name (expand-file-name rmail-file-name)) ! (equal buffer-file-truename (file-truename rmail-file-name))) (setq rmail-inbox-list (or rmail-primary-inbox-list *************** *** 753,757 **** nil) ((and (not movemail) (not popmail)) ! (rename-file file tofile nil) ;; Make the real inbox file empty. ;; Leaving it deleted could cause lossage --- 758,767 ---- nil) ((and (not movemail) (not popmail)) ! ;; Try copying. If that fails (perhaps no space), ! ;; rename instead. ! (condition-case nil ! (copy-file file tofile nil) ! (error ! (rename-file file tofile nil))) ;; Make the real inbox file empty. ;; Leaving it deleted could cause lossage *************** *** 1643,1646 **** --- 1653,1664 ---- ;;;; *** Rmail Mailing Commands *** + (defun rmail-start-mail (&rest args) + (if rmail-mail-new-frame + (progn + (apply 'mail-other-frame args) + (modify-frame-parameters (selected-frame) + '((dedicated . t)))) + (apply 'mail-other-window args))) + (defun rmail-mail () "Send mail in another window. *************** *** 1648,1657 **** original message into it." (interactive) ! (mail-other-window nil nil nil nil nil (current-buffer))) (defun rmail-continue () "Continue composing outgoing message previously being composed." (interactive) ! (mail-other-window t)) (defun rmail-reply (just-sender) --- 1666,1675 ---- original message into it." (interactive) ! (rmail-start-mail nil nil nil nil nil (current-buffer))) (defun rmail-continue () "Continue composing outgoing message previously being composed." (interactive) ! (rmail-start-mail t)) (defun rmail-reply (just-sender) *************** *** 1703,1707 **** subject) (setq subject (concat rmail-reply-prefix subject)))) ! (mail-other-window nil (mail-strip-quoted-names reply-to) subject --- 1721,1725 ---- subject) (setq subject (concat rmail-reply-prefix subject)))) ! (rmail-start-mail nil (mail-strip-quoted-names reply-to) subject *************** *** 1798,1802 **** (if (funcall (if (one-window-p t) (function mail) ! (function mail-other-window)) nil nil subject nil nil nil (list (list (function (lambda (buf msgnum) --- 1816,1820 ---- (if (funcall (if (one-window-p t) (function mail) ! (function rmail-start-mail)) nil nil subject nil nil nil (list (list (function (lambda (buf msgnum) *************** *** 1839,1843 **** ;;>> Insert resent-from: (insert "Resent-From: " from "\n") ! (insert "Resent-Date: " (current-time-string) "\n") ;;>> Insert resent-to: and bcc if need be. (let ((before (point))) --- 1857,1861 ---- ;;>> Insert resent-from: (insert "Resent-From: " from "\n") ! (insert "Resent-Date: " (mail-rfc822-date) "\n") ;;>> Insert resent-to: and bcc if need be. (let ((before (point))) *************** *** 1902,1906 **** ;; because we want to get only the text from the failure message. (let (mail-signature mail-setup-hook) ! (if (mail-other-window nil to subj irp2 cc (current-buffer)) ;; Insert original text as initial text of new draft message. (progn --- 1920,1924 ---- ;; because we want to get only the text from the failure message. (let (mail-signature mail-setup-hook) ! (if (rmail-start-mail nil to subj irp2 cc (current-buffer)) ;; Insert original text as initial text of new draft message. (progn diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/rmailout.el emacs-19.17/lisp/rmailout.el *** emacs-19.16/lisp/rmailout.el Fri Jun 18 21:23:02 1993 --- emacs-19.17/lisp/rmailout.el Sat Jul 10 01:09:15 1993 *************** *** 1,5 **** ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. ! ;; Copyright (C) 1985, 1987 Free Software Foundation, Inc. ;; Maintainer: FSF --- 1,5 ---- ;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. ! ;; Copyright (C) 1985, 1987, 1993 Free Software Foundation, Inc. ;; Maintainer: FSF *************** *** 30,34 **** (defvar rmail-output-file-alist nil "*Alist matching regexps to suggested output Rmail files. ! This is a list of elements of the form (REGEXP . FILENAME).") ;;; There are functions elsewhere in Emacs that use this function; check --- 30,37 ---- (defvar rmail-output-file-alist nil "*Alist matching regexps to suggested output Rmail files. ! This is a list of elements of the form (REGEXP . NAME-EXP). ! NAME-EXP may be a string constant giving the file name to use, ! or more generally it may be any kind of expression that returns ! a file name as a string.") ;;; There are functions elsewhere in Emacs that use this function; check *************** *** 39,42 **** --- 42,48 ---- If file is being visited, the message is appended to the Emacs buffer visiting that file. + If the file exists and is not an Rmail file, + the message is appended in inbox format. + A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count." *************** *** 50,54 **** (goto-char (point-min)) (if (re-search-forward (car (car tail)) nil t) ! (setq answer (cdr (car tail)))) (setq tail (cdr tail)))) ;; If not suggestions, use same file as last time. --- 56,60 ---- (goto-char (point-min)) (if (re-search-forward (car (car tail)) nil t) ! (setq answer (eval (cdr (car tail))))) (setq tail (cdr tail)))) ;; If not suggestions, use same file as last time. *************** *** 65,131 **** (expand-file-name file-name (file-name-directory rmail-last-rmail-file))) ! (setq rmail-last-rmail-file file-name) ! (rmail-maybe-set-message-counters) ! (setq file-name (abbreviate-file-name file-name)) ! (or (get-file-buffer file-name) ! (file-exists-p file-name) ! (if (yes-or-no-p ! (concat "\"" file-name "\" does not exist, create it? ")) ! (let ((file-buffer (create-file-buffer file-name))) ! (save-excursion ! (set-buffer file-buffer) ! (rmail-insert-rmail-file-header) ! (let ((require-final-newline nil)) ! (write-region (point-min) (point-max) file-name t 1))) ! (kill-buffer file-buffer)) ! (error "Output file does not exist"))) ! (while (> count 0) ! (let (redelete) ! (unwind-protect ! (progn ! (save-restriction ! (widen) ! (if (rmail-message-deleted-p rmail-current-message) ! (progn (setq redelete t) ! (rmail-set-attribute "deleted" nil))) ! ;; Decide whether to append to a file or to an Emacs buffer. (save-excursion ! (let ((buf (get-file-buffer file-name)) ! (cur (current-buffer)) ! (beg (1+ (rmail-msgbeg rmail-current-message))) ! (end (1+ (rmail-msgend rmail-current-message)))) ! (if (not buf) ! (append-to-file beg end file-name) ! (if (eq buf (current-buffer)) ! (error "Can't output message to same file it's already in")) ! ;; File has been visited, in buffer BUF. ! (set-buffer buf) ! (let ((buffer-read-only nil) ! (msg (and (boundp 'rmail-current-message) ! rmail-current-message))) ! ;; If MSG is non-nil, buffer is in RMAIL mode. ! (if msg ! (progn ! (rmail-maybe-set-message-counters) ! (widen) ! (narrow-to-region (point-max) (point-max)) ! (insert-buffer-substring cur beg end) ! (goto-char (point-min)) ! (widen) ! (search-backward "\n\^_") ! (narrow-to-region (point) (point-max)) ! (rmail-count-new-messages t) ! (rmail-show-message msg)) ! ;; Output file not in rmail mode => just insert at the end. ! (narrow-to-region (point-min) (1+ (buffer-size))) ! (goto-char (point-max)) ! (insert-buffer-substring cur beg end))))))) ! (rmail-set-attribute "filed" t)) ! (if redelete (rmail-set-attribute "deleted" t)))) ! (setq count (1- count)) ! (if rmail-delete-after-output ! (rmail-delete-forward) ! (if (> count 0) ! (rmail-next-undeleted-message 1))))) ;;; There are functions elsewhere in Emacs that use this function; check --- 71,149 ---- (expand-file-name file-name (file-name-directory rmail-last-rmail-file))) ! (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)) ! (or (get-file-buffer file-name) ! (file-exists-p file-name) ! (if (yes-or-no-p ! (concat "\"" file-name "\" does not exist, create it? ")) ! (let ((file-buffer (create-file-buffer file-name))) (save-excursion ! (set-buffer file-buffer) ! (rmail-insert-rmail-file-header) ! (let ((require-final-newline nil)) ! (write-region (point-min) (point-max) file-name t 1))) ! (kill-buffer file-buffer)) ! (error "Output file does not exist"))) ! (while (> count 0) ! (let (redelete) ! (unwind-protect ! (progn ! (save-restriction ! (widen) ! (if (rmail-message-deleted-p rmail-current-message) ! (progn (setq redelete t) ! (rmail-set-attribute "deleted" nil))) ! ;; Decide whether to append to a file or to an Emacs buffer. ! (save-excursion ! (let ((buf (get-file-buffer file-name)) ! (cur (current-buffer)) ! (beg (1+ (rmail-msgbeg rmail-current-message))) ! (end (1+ (rmail-msgend rmail-current-message)))) ! (if (not buf) ! (append-to-file beg end file-name) ! (if (eq buf (current-buffer)) ! (error "Can't output message to same file it's already in")) ! ;; File has been visited, in buffer BUF. ! (set-buffer buf) ! (let ((buffer-read-only nil) ! (msg (and (boundp 'rmail-current-message) ! rmail-current-message))) ! ;; If MSG is non-nil, buffer is in RMAIL mode. ! (if msg ! (progn ! (rmail-maybe-set-message-counters) ! (widen) ! (narrow-to-region (point-max) (point-max)) ! (insert-buffer-substring cur beg end) ! (goto-char (point-min)) ! (widen) ! (search-backward "\n\^_") ! (narrow-to-region (point) (point-max)) ! (rmail-count-new-messages t) ! (rmail-show-message msg)) ! ;; Output file not in rmail mode => just insert at the end. ! (narrow-to-region (point-min) (1+ (buffer-size))) ! (goto-char (point-max)) ! (insert-buffer-substring cur beg end))))))) ! (rmail-set-attribute "filed" t)) ! (if redelete (rmail-set-attribute "deleted" t)))) ! (setq count (1- count)) ! (if rmail-delete-after-output ! (rmail-delete-forward) ! (if (> count 0) ! (rmail-next-undeleted-message 1)))))) ! ! ;; Returns t if file FILE is an Rmail file. ! (defun rmail-file-p (file) ! (let ((buf (generate-new-buffer " *rmail-file-p*"))) ! (unwind-protect ! (save-excursion ! (set-buffer buf) ! (insert-file-contents file nil 0 100) ! (looking-at "BABYL OPTIONS:")) ! (kill-buffer buf)))) ;;; There are functions elsewhere in Emacs that use this function; check *************** *** 152,199 **** (and rmail-last-file (file-name-directory rmail-last-file)))) ! (setq rmail-last-file file-name) ! (while (> count 0) ! (let ((rmailbuf (current-buffer)) ! (tembuf (get-buffer-create " rmail-output")) ! (case-fold-search t)) ! (save-excursion ! (set-buffer tembuf) ! (erase-buffer) ! ;; If we can do it, read a little of the file ! ;; to check whether it is an RMAIL file. ! ;; If it is, don't mess it up. ! (and (file-readable-p file-name) ! (progn (insert-file-contents file-name nil 0 20) ! (looking-at "BABYL OPTIONS:\n")) ! (error (save-excursion ! (set-buffer rmailbuf) ! (substitute-command-keys ! "Use \\[rmail-output-to-rmail-file] to output to Rmail file `%s'")) ! (file-name-nondirectory file-name))) ! (erase-buffer) ! (insert-buffer-substring rmailbuf) ! (insert "\n") ! (goto-char (point-min)) ! (insert "From " ! (mail-strip-quoted-names (or (mail-fetch-field "from") ! (mail-fetch-field "really-from") ! (mail-fetch-field "sender") ! "unknown")) ! " " (current-time-string) "\n") ! ;; ``Quote'' "\nFrom " as "\n>From " ! ;; (note that this isn't really quoting, as there is no requirement ! ;; that "\n[>]+From " be quoted in the same transparent way.) ! (while (search-forward "\nFrom " nil t) ! (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 ! (rmail-delete-forward) ! (if (> count 0) ! (rmail-next-undeleted-message 1))))) ;;; rmailout.el ends here --- 170,207 ---- (and rmail-last-file (file-name-directory rmail-last-file)))) ! (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)) ! (tembuf (get-buffer-create " rmail-output")) ! (case-fold-search t)) ! (save-excursion ! (set-buffer tembuf) ! (erase-buffer) ! (insert-buffer-substring rmailbuf) ! (insert "\n") ! (goto-char (point-min)) ! (insert "From " ! (mail-strip-quoted-names (or (mail-fetch-field "from") ! (mail-fetch-field "really-from") ! (mail-fetch-field "sender") ! "unknown")) ! " " (current-time-string) "\n") ! ;; ``Quote'' "\nFrom " as "\n>From " ! ;; (note that this isn't really quoting, as there is no requirement ! ;; that "\n[>]+From " be quoted in the same transparent way.) ! (while (search-forward "\nFrom " nil t) ! (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 ! (rmail-delete-forward) ! (if (> count 0) ! (rmail-next-undeleted-message 1)))))) ;;; rmailout.el ends here diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/sendmail.el emacs-19.17/lisp/sendmail.el *** emacs-19.16/lisp/sendmail.el Thu Jul 1 19:35:15 1993 --- emacs-19.17/lisp/sendmail.el Fri Jul 16 00:18:34 1993 *************** *** 249,252 **** --- 249,255 ---- '("Insert Signature" . mail-signature)) + (define-key mail-mode-map [menu-bar mail cancel] + '("Cancel" . mail-dont-send)) + (define-key mail-mode-map [menu-bar mail send-stay] '("Send, Keep Editing" . mail-send)) *************** *** 284,296 **** (interactive "P") (mail-send) (let ((newbuf (other-buffer (current-buffer)))) (bury-buffer (current-buffer)) ! (if (and (not arg) ! (not (one-window-p)) ! (save-excursion ! (set-buffer (window-buffer (next-window (selected-window) 'not))) ! (eq major-mode 'rmail-mode))) ! (delete-window) ! (switch-to-buffer newbuf)))) (defun mail-send () --- 287,312 ---- (interactive "P") (mail-send) + (mail-bury arg)) + + (defun mail-dont-send (arg) + "Don't send the message you have been editing. + Prefix arg means don't delete this window." + (interactive "P") + (mail-bury arg)) + + (defun mail-bury (arg) + "Bury this mail buffer." (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)) ! (if (and (not arg) ! (not (one-window-p)) ! (save-excursion ! (set-buffer (window-buffer (next-window (selected-window) 'not))) ! (eq major-mode 'rmail-mode))) ! (delete-window) ! (switch-to-buffer newbuf))))) (defun mail-send () *************** *** 423,427 **** (rmailbuf (current-buffer)) (time (current-time)) - timezone (tembuf (generate-new-buffer " rmail output")) (case-fold-search t)) --- 439,442 ---- *************** *** 437,447 **** (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) - (let* ((foo (current-time-zone time)) - (offset (if (car foo) (/ (car foo) 60) 0)) - (abs (abs offset))) - (setq timezone (format "%s%02d%02d" - (if (< offset 0) "-" "+") - (/ abs 60) - (% abs 60)))) (set-buffer tembuf) (erase-buffer) --- 452,455 ---- *************** *** 452,456 **** (forward-char -1) (forward-word -1) ! (insert timezone " ") (goto-char (point-max)) (insert-buffer-substring rmailbuf) --- 460,465 ---- (forward-char -1) (forward-word -1) ! (require 'mail-utils) ! (insert (mail-rfc822-time-zone time) " ") (goto-char (point-max)) (insert-buffer-substring rmailbuf) *************** *** 494,498 **** (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" "From: " (user-login-name) "\n" ! "Date: " (current-time-string) "\n") (insert-buffer-substring curbuf beg2 end) (insert "\n\C-_") --- 503,507 ---- (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" "From: " (user-login-name) "\n" ! "Date: " (mail-rfc822-date) "\n") (insert-buffer-substring curbuf beg2 end) (insert "\n\C-_") diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/server.el emacs-19.17/lisp/server.el *** emacs-19.16/lisp/server.el Tue Jun 15 19:09:27 1993 --- emacs-19.17/lisp/server.el Thu Jul 15 00:01:05 1993 *************** *** 269,276 **** (progn (if (server-temp-file-p buffer) ! (progn (save-buffer) ! (write-region (point-min) (point-max) ! (concat buffer-file-name "~")) ! (kill-buffer buffer)) (if (and (buffer-modified-p) (y-or-n-p (concat "Save file " buffer-file-name "? "))) --- 269,278 ---- (progn (if (server-temp-file-p buffer) ! ;; For a temp file, save, and do make a non-numeric backup ! ;; (unless make-backup-files is nil). ! (let ((version-control nil) ! (buffer-backed-up nil)) ! (save-buffer) ! (kill-buffer buffer)) (if (and (buffer-modified-p) (y-or-n-p (concat "Save file " buffer-file-name "? "))) *************** *** 284,288 **** Temporary files such as MH files are always saved and backed up, ! no questions asked. The variable `server-temp-file-regexp' controls which filenames are considered temporary. --- 286,292 ---- Temporary files such as MH files are always saved and backed up, ! no questions asked. (The variable `make-backup-files', if nil, still ! inhibits a backup; you can set it locally in a particular buffer to ! prevent a backup for it.) The variable `server-temp-file-regexp' controls which filenames are considered temporary. diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/shell.el emacs-19.17/lisp/shell.el *** emacs-19.16/lisp/shell.el Tue Jun 1 17:40:54 1993 --- emacs-19.17/lisp/shell.el Sun Jul 18 02:02:19 1993 *************** *** 145,154 **** ;;;###autoload ! (defvar shell-prompt-pattern "^[^#$%>]*[#$%>] *" "Regexp to match prompts in the inferior shell. ! Defaults to \"^[^#$%>]*[#$%>] *\", which works pretty well. This variable is used to initialise `comint-prompt-regexp' in the shell buffer. This is a fine thing to set in your `.emacs' file.") --- 145,158 ---- ;;;###autoload ! (defvar shell-prompt-pattern "^[^#$%>\n]*[#$%>] *" "Regexp to match prompts in the inferior shell. ! Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well. This variable is used to initialise `comint-prompt-regexp' in the shell buffer. + The pattern should probably not match more than one line. If it does, + shell-mode may become confused trying to distinguish prompt from input + on lines which don't start with a prompt. + This is a fine thing to set in your `.emacs' file.") *************** *** 415,419 **** (shell-dirstack-message)) (message "Directory stack empty.")) ! (message "Couldn't cd.")) (let ((num (shell-extract-num arg))) --- 419,424 ---- (shell-dirstack-message)) (message "Directory stack empty.")) ! (error ! (message "Couldn't cd."))) (let ((num (shell-extract-num arg))) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/simple.el emacs-19.17/lisp/simple.el *** emacs-19.16/lisp/simple.el Mon Jul 5 17:21:09 1993 --- emacs-19.17/lisp/simple.el Thu Jul 15 01:46:45 1993 *************** *** 1095,1103 **** ;; If user quit, deactivate the mark ;; as C-g would as a command. ! (and quit-flag transient-mark-mode mark-active (progn ! (message "foo") ! (setq mark-active nil) ! (run-hooks 'deactivate-mark-hook)))) (let* ((killed-text (current-kill 0)) (message-len (min (length killed-text) 40))) --- 1095,1102 ---- ;; If user quit, deactivate the mark ;; 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))) *************** *** 1245,1248 **** --- 1244,1250 ---- behave as if the mark were still active.") + (put 'mark-inactive 'error-conditions '(mark-inactive error)) + (put 'mark-inactive 'error-message "The mark is not active now") + (defun mark (&optional force) "Return this buffer's mark value as integer; error if mark inactive. *************** *** 1255,1259 **** (if (or force mark-active mark-even-if-inactive) (marker-position (mark-marker)) ! (error "The mark is not currently active"))) (defun set-mark (pos) --- 1257,1269 ---- (if (or force mark-active mark-even-if-inactive) (marker-position (mark-marker)) ! (signal 'mark-inactive nil))) ! ! ;; Many places set mark-active directly, and several of them failed to also ! ;; run deactivate-mark-hook. This shorthand should simplify. ! (defsubst deactivate-mark () ! "Deactivate the mark by setting `mark-active' to nil. ! Also runs the hook `deactivate-mark-hook'." ! (setq mark-active nil) ! (run-hooks 'deactivate-mark-hook)) (defun set-mark (pos) *************** *** 1332,1337 **** (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker))))) (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer)) ! (if transient-mark-mode ! (setq mark-active nil)) (move-marker (car mark-ring) nil) (if (null (mark t)) (ding)) --- 1342,1346 ---- (setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker))))) (set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer)) ! (deactivate-mark) (move-marker (car mark-ring) nil) (if (null (mark t)) (ding)) *************** *** 2147,2154 **** At top-level, as an editor command, this simply beeps." (interactive) ! (and transient-mark-mode mark-active ! (progn ! (setq mark-active nil) ! (run-hooks 'deactivate-mark-hook))) (signal 'quit nil)) --- 2156,2160 ---- At top-level, as an editor command, this simply beeps." (interactive) ! (deactivate-mark) (signal 'quit nil)) *************** *** 2189,2193 **** --- 2195,2230 ---- (eval-minibuffer (format "Set %s to value: " var))))))) (set var val)) + + ;; 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 + (insert (substitute-command-keys + "Click \\[mouse-choose-completion] on a completion to select it.\n\n"))))) + (add-hook 'completion-setup-hook 'completion-setup-function) ;;;; Keypad support. diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/spook.el emacs-19.17/lisp/spook.el *** emacs-19.16/lisp/spook.el Tue Jun 1 00:28:50 1993 --- emacs-19.17/lisp/spook.el Wed Jul 14 19:37:09 1993 *************** *** 1,5 **** ;;; spook.el --- spook phrase utility for overloading the NSA line eater ! ;; Copyright (C) 1988 Free Software Foundation, Inc. ;; Maintainer: FSF --- 1,5 ---- ;;; spook.el --- spook phrase utility for overloading the NSA line eater ! ;; Copyright (C) 1988, 1993 Free Software Foundation, Inc. ;; Maintainer: FSF *************** *** 50,61 **** "Adds that special touch of class to your outgoing mail." (interactive) ! (cookie-insert ! spook-phrases-file ! spook-phrase-default-count ! "Checking authorization" ! "Checking authorization...Approved")) ! ;; Note: the implementation that used to take up most of this file has ! ;; been cleaned up and generalized and now resides in cookie1.el. ;;; spook.el ends here --- 50,68 ---- "Adds that special touch of class to your outgoing mail." (interactive) ! (cookie-insert spook-phrases-file ! spook-phrase-default-count ! "Checking authorization..." ! "Checking authorization...Approved")) ! ;;;###autoload ! (defun snarf-spooks () ! "Return a vector containing the lines from `spook-phrases-file'." ! (cookie-snarf spook-phrases-file ! "Checking authorization..." ! "Checking authorization...Approved")) ! ! ;; Note: the implementation that used to take up most of this file has been ! ;; cleaned up, generalized, gratuitously broken by esr, and now resides in ! ;; cookie1.el. ;;; spook.el ends here diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/subr.el emacs-19.17/lisp/subr.el *** emacs-19.16/lisp/subr.el Mon Jul 5 00:33:20 1993 --- emacs-19.17/lisp/subr.el Mon Jul 12 23:59:40 1993 *************** *** 187,193 **** just after the binding for the event AFTER, instead of at the beginning of the map. ! The order matters when the keymap is used as a menu." (or (keymapp keymap) (signal 'wrong-type-argument (list 'keymapp keymap))) (let ((tail keymap) done inserted (first (aref key 0))) --- 187,197 ---- just after the binding for the event AFTER, instead of at the beginning of the map. ! The order matters when the keymap is used as a menu. ! KEY must contain just one event type--it must be a string or vector ! of length 1." (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 (first (aref key 0))) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/tar-mode.el emacs-19.17/lisp/tar-mode.el *** emacs-19.16/lisp/tar-mode.el Tue Jun 1 17:41:47 1993 --- emacs-19.17/lisp/tar-mode.el Sat Jul 17 15:09:57 1993 *************** *** 625,632 **** (progn (view-buffer buffer) ! (and just-created (kill-buffer buffer))) ! (if other-window-p ! (switch-to-buffer-other-window buffer) ! (switch-to-buffer buffer)))))) --- 625,633 ---- (progn (view-buffer buffer) ! (and just-created ! (setq view-exit-action 'kill-buffer))) ! (if other-window-p ! (switch-to-buffer-other-window buffer) ! (switch-to-buffer buffer)))))) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/term/x-win.el emacs-19.17/lisp/term/x-win.el *** emacs-19.16/lisp/term/x-win.el Sat Jul 3 05:41:03 1993 --- emacs-19.17/lisp/term/x-win.el Sun Jul 18 02:01:21 1993 *************** *** 66,70 **** (if (not (eq window-system 'x)) ! (error "Loading x-win.el but not compiled for X")) (require 'frame) --- 66,70 ---- (if (not (eq window-system 'x)) ! (error "%s: Loading x-win.el but not compiled for X" (invocation-name))) (require 'frame) *************** *** 83,87 **** ("-d" . x-handle-display) ("-display" . x-handle-display) ! ("-name" . x-handle-switch) ("-T" . x-handle-switch) ("-r" . x-handle-switch) --- 83,88 ---- ("-d" . x-handle-display) ("-display" . x-handle-display) ! ("-name" . x-handle-name-rn-switch) ! ("-rn" . x-handle-name-rn-switch) ("-T" . x-handle-switch) ("-r" . x-handle-switch) *************** *** 101,105 **** ("-i" . x-handle-switch) ("-iconic" . x-handle-switch) ! ("-rn" . x-handle-rn-switch) ("-cr" . x-handle-switch) ("-vb" . x-handle-switch) --- 102,106 ---- ("-i" . x-handle-switch) ("-iconic" . x-handle-switch) ! ("-xrm" . x-handle-xrm-switch) ("-cr" . x-handle-switch) ("-vb" . x-handle-switch) *************** *** 156,161 **** (cdr x-invocation-args))))) ! ;; Handle the -rn option. ! (defun x-handle-rn-switch (switch) (setq x-command-line-resources (car x-invocation-args)) (setq x-invocation-args (cdr x-invocation-args))) --- 157,164 ---- (cdr x-invocation-args))))) ! ;; Handle the -xrm option. ! (defun x-handle-xrm-switch (switch) ! (or (consp x-invocation-args) ! (error "%s: missing argument to `%s' option" (invocation-name) switch)) (setq x-command-line-resources (car x-invocation-args)) (setq x-invocation-args (cdr x-invocation-args))) *************** *** 168,171 **** --- 171,186 ---- x-invocation-args (cdr x-invocation-args))) + ;; Handle the -name and -rn options. Set the variable x-resource-name + ;; to the option's operand; if the switch was `-name', set the name of + ;; the initial frame, too. + (defun x-handle-name-rn-switch (switch) + (or (consp x-invocation-args) + (error "%s: missing argument to `%s' option" (invocation-name) switch)) + (setq x-resource-name (car x-invocation-args) + x-invocation-args (cdr x-invocation-args)) + (if (string= switch "-name") + (setq initial-frame-alist (cons (cons 'name x-resource-name) + initial-frame-alist)))) + (defvar x-display-name nil "The X display name specifying server and X frame.") *************** *** 516,519 **** --- 531,545 ---- (setq command-line-args (x-handle-args command-line-args)) + + ;;; Make sure we have a valid resource name. + (or (stringp x-resource-name) + (let (i) + (setq x-resource-name (invocation-name)) + + ;; Change any . or * characters in x-resource-name to hyphens, + ;; so as not to choke when we use it in X resource queries. + (while (setq i (string-match "[.*]" x-resource-name)) + (aset x-resource-name i ?-)))) + (x-open-connection (or x-display-name (setq x-display-name (getenv "DISPLAY"))) *************** *** 531,539 **** ;; Check the reverseVideo resource. ! (if (assoc ! (x-get-resource "reverseVideo" ! "ReverseVideo") ! '("True" "true" "Yes" "yes")) ! (setq default-frame-alist (cons '(reverse . t) default-frame-alist))) ;; Set x-selection-timeout, measured in milliseconds. --- 557,566 ---- ;; Check the reverseVideo resource. ! (let ((case-fold-search t)) ! (let ((rv (x-get-resource "reverseVideo" "ReverseVideo"))) ! (if (and rv ! (string-match "^\\(true\\|yes\\|on\\)$" rv)) ! (setq default-frame-alist ! (cons '(reverse . t) default-frame-alist))))) ;; Set x-selection-timeout, measured in milliseconds. diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/texinfo.el emacs-19.17/lisp/texinfo.el *** emacs-19.16/lisp/texinfo.el Mon Jun 21 02:46:49 1993 --- emacs-19.17/lisp/texinfo.el Sat Jul 17 13:25:26 1993 *************** *** 368,374 **** (make-local-variable 'words-include-escapes) (setq words-include-escapes t) ! (make-local-variable 'texinfo-start-of-header) (setq tex-start-of-header "%**start") ! (make-local-variable 'texinfo-end-of-header) (setq tex-end-of-header "%**end") (run-hooks 'text-mode-hook 'texinfo-mode-hook)) --- 368,374 ---- (make-local-variable 'words-include-escapes) (setq words-include-escapes t) ! (make-local-variable 'tex-start-of-header) (setq tex-start-of-header "%**start") ! (make-local-variable 'tex-end-of-header) (setq tex-end-of-header "%**end") (run-hooks 'text-mode-hook 'texinfo-mode-hook)) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/texnfo-upd.el emacs-19.17/lisp/texnfo-upd.el *** emacs-19.16/lisp/texnfo-upd.el Wed Jun 9 07:28:34 1993 --- emacs-19.17/lisp/texnfo-upd.el Wed Jul 7 18:21:00 1993 *************** *** 1,8 **** ! ;;; texnfo-upd.el --- a utility for updating nodes and menus in Texinfo files. ! ;;;; Copyright 1989, 1990, 1992 Free Software Foundation ! ! ;; Author: Bob Chassell ! ;; Version: 2.00 ;; Keywords: maint, tex, docs --- 1,7 ---- ! ;;; Texinfo mode utilities for updating nodes and menus in Texinfo files. ! ;;; Copyright 1989, 1990, 1991, 1992 Free Software Foundation ! ;; Author: Robert J. Chassell ! ;; Maintainer: bug-texinfo@prep.ai.mit.edu ;; Keywords: maint, tex, docs *************** *** 24,33 **** ;;; Commentary: - - ;;;; Summary ! ; (Much of the following commentary ought eventually be incorporated ! ; into the Texinfo Manual.) ; The node and menu updating functions automatically --- 23,31 ---- ;;; Commentary: ! ;;; Known bug: update commands fail to ignore @ignore. + ;;; Summary: how to use the updating commands + ; The node and menu updating functions automatically *************** *** 36,46 **** ; * insert or update the menu for a section, ; * create a master menu for a Texinfo source file. ! ; Passed an argument, the `texinfo-update-node' and ; `texinfo-make-menu' functions do their jobs in the region. ! ! ; These functions replace doing these jobs by hand. ! ; You may find them helpful. ! ; In brief, the functions for creating or updating nodes and menus, are: ; --- 34,41 ---- ; * insert or update the menu for a section, ; * create a master menu for a Texinfo source file. ! ; ; Passed an argument, the `texinfo-update-node' and ; `texinfo-make-menu' functions do their jobs in the region. ! ; ; In brief, the functions for creating or updating nodes and menus, are: ; *************** *** 82,87 **** ! ;;;; The updating functions in detail ! ; -------------------------------- ; The `texinfo-update-node' function without an argument inserts --- 77,81 ---- ! ;;; The update node functions described in detail ; The `texinfo-update-node' function without an argument inserts *************** *** 99,107 **** ; on the whole buffer. ! ; The `texinfo-update-node' function inserts the immediately following ! ; and preceding node into the `Next' or `Previous' pointers regardless ! ; of their hierarchical level. This is only useful for certain kinds ! ; of text, like a novel, which you go through sequentially. ; The `texinfo-make-menu' function without an argument creates or ; updates a menu for the section encompassing the node that follows --- 93,105 ---- ; on the whole buffer. ! ; The `texinfo-sequential-node-update' function inserts the ! ; immediately following and preceding node into the `Next' or ! ; `Previous' pointers regardless of their hierarchical level. This is ! ; only useful for certain kinds of text, like a novel, which you go ! ; through sequentially. + + ;;; The menu making functions described in detail + ; The `texinfo-make-menu' function without an argument creates or ; updates a menu for the section encompassing the node that follows *************** *** 147,154 **** ; titles, node names so inserted will need to be edited manually. - ;;; Code: ! ;;;; Menu Making Functions (defun texinfo-make-menu (&optional region-p) "Without any prefix argument, make or update a menu. --- 145,153 ---- ; titles, node names so inserted will need to be edited manually. ! ;;; Code: + ;;; The menu making functions + (defun texinfo-make-menu (&optional region-p) "Without any prefix argument, make or update a menu. *************** *** 169,173 **** (message "Done...updated the menu. You may save the buffer.")) ;; else ! (message "Making or updating menus... ") (let ((beginning (region-beginning)) (region-end (region-end)) --- 168,172 ---- (message "Done...updated the menu. You may save the buffer.")) ;; else ! (message "Making or updating menus in %s... " (buffer-name)) (let ((beginning (region-beginning)) (region-end (region-end)) *************** *** 208,211 **** --- 207,211 ---- (node-name (progn (goto-char beginning) + (beginning-of-line) (texinfo-copy-node-name))) (new-menu-list (texinfo-make-menu-list beginning end level))) *************** *** 213,216 **** --- 213,217 ---- (progn (texinfo-incorporate-descriptions new-menu-list) + (texinfo-incorporate-menu-entry-names new-menu-list) (texinfo-delete-old-menu beginning first))) (texinfo-insert-menu new-menu-list node-name))) *************** *** 218,245 **** (defun texinfo-all-menus-update (&optional update-all-nodes-p) "Update every regular menu in a Texinfo file. ! You must remove the detailed part of a pre-existing master menu before ! running this command, lest it be partly duplicated. If called with a non-nil argument, this function first updates all the nodes in the buffer before updating the menus." (interactive "P") ! (save-excursion ! (mark-whole-buffer) ! (message "Checking for a master menu... ") (save-excursion ! (if (re-search-forward texinfo-master-menu-header nil t) ! (error ! "Please remove existing master menu, lest it be partly duplicated!"))) ! ! (if update-all-nodes-p ! (progn ! (message "First updating all nodes... ") ! (sleep-for 2) ! (mark-whole-buffer) ! (texinfo-update-node t))) ! ! (message "Updating all menus... ") ! (sleep-for 2) ! (texinfo-make-menu t) (message "Done...updated all the menus. You may save the buffer."))) --- 219,266 ---- (defun texinfo-all-menus-update (&optional update-all-nodes-p) "Update every regular menu in a Texinfo file. ! Update pre-existing master menu, if there is one. If called with a non-nil argument, this function first updates all the nodes in the buffer before updating the menus." (interactive "P") ! (let ((case-fold-search t) ! master-menu-p) (save-excursion ! (push-mark (point-max) t) ! (goto-char (point-min)) ! (message "Checking for a master menu in %s ... "(buffer-name)) ! (save-excursion ! (if (re-search-forward texinfo-master-menu-header nil t) ! ;; Remove detailed master menu listing ! (progn ! (setq master-menu-p t) ! (goto-char (match-beginning 0)) ! (let ((end-of-detailed-menu-descriptions ! (save-excursion ; beginning of end menu line ! (goto-char (texinfo-menu-end)) ! (beginning-of-line) (forward-char -1) ! (point)))) ! (delete-region (point) end-of-detailed-menu-descriptions))))) ! ! (if update-all-nodes-p ! (progn ! (message "Updating all nodes in %s ... " (buffer-name)) ! (sleep-for 2) ! (push-mark (point-max) t) ! (goto-char (point-min)) ! (texinfo-update-node t))) ! ! (message "Updating all menus in %s ... " (buffer-name)) ! (sleep-for 2) ! (push-mark (point-max) t) ! (goto-char (point-min)) ! (texinfo-make-menu t) ! ! (if master-menu-p ! (progn ! (message "Updating the master menu in %s... " (buffer-name)) ! (sleep-for 2) ! (texinfo-master-menu nil)))) ! (message "Done...updated all the menus. You may save the buffer."))) *************** *** 251,269 **** Return t if the node is found, else nil. Leave point at the beginning of the node if one is found; else do not move point." ! ! (if (and (< (point) region-end) ! (re-search-forward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval (cdr (assoc level texinfo-update-menu-lower-regexps)))) ! ;; the next higher level node marks the end of this ! ;; section, and no lower level node will be found beyond ! ;; this position even if region-end is farther off ! (texinfo-update-menu-region-end level) ! t)) ! (goto-char (match-beginning 1)))) (defun texinfo-find-higher-level-node (level region-end) --- 272,290 ---- Return t if the node is found, else nil. Leave point at the beginning of the node if one is found; else do not move point." ! (let ((case-fold-search t)) ! (if (and (< (point) region-end) ! (re-search-forward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval (cdr (assoc level texinfo-update-menu-lower-regexps)))) ! ;; the next higher level node marks the end of this ! ;; section, and no lower level node will be found beyond ! ;; this position even if region-end is farther off ! (texinfo-update-menu-region-end level) ! t)) ! (goto-char (match-beginning 1))))) (defun texinfo-find-higher-level-node (level region-end) *************** *** 273,292 **** Return t if the node is found, else nil. Leave point at the beginning of the node if one is found; else do not move point." ! ! (if (and (< (point) region-end) ! (re-search-forward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval ; (won't ever find a `top' node) ! (cdr (assoc level texinfo-update-menu-higher-regexps)))) ! nil ! t)) ! (goto-char (match-beginning 1)))) ! ;;;; Making the list of new menu entries (defun texinfo-make-menu-list (beginning end level) --- 294,315 ---- Return t if the node is found, else nil. Leave point at the beginning of the node if one is found; else do not move point." ! (let ((case-fold-search t)) ! (cond ! ((or (string-equal "top" level) (string-equal "chapter" level)) ! (if (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" region-end t) ! (progn (beginning-of-line) t))) ! (t ! (if (re-search-forward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval (cdr (assoc level texinfo-update-menu-higher-regexps)))) ! region-end t) ! (progn (beginning-of-line) t)))))) ! ;;; Making the list of new menu entries (defun texinfo-make-menu-list (beginning end level) *************** *** 307,311 **** (cons (cons (texinfo-copy-node-name) ! (texinfo-copy-section-title)) new-menu-list))) (reverse new-menu-list))) --- 330,336 ---- (cons (cons (texinfo-copy-node-name) ! (prog1 "" (forward-line 1))) ! ;; Use following to insert section titles automatically. ! ;; (texinfo-copy-section-title)) new-menu-list))) (reverse new-menu-list))) *************** *** 314,318 **** "Find a node that will be part of menu for this section. First argument is a string such as \"section\" specifying the general ! hierarchical level of the menu; second argument is a postion specifying the end of the search. --- 339,343 ---- "Find a node that will be part of menu for this section. First argument is a string such as \"section\" specifying the general ! hierarchical level of the menu; second argument is a position specifying the end of the search. *************** *** 322,336 **** The function finds entries of the same type. Thus `subsections' and `unnumberedsubsecs' will appear in the same menu." ! (if (re-search-forward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval ! (cdr (assoc level texinfo-update-menu-same-level-regexps)))) ! search-end ! t) ! (goto-char (match-beginning 1)))) (defun texinfo-copy-node-name () --- 347,362 ---- The function finds entries of the same type. Thus `subsections' and `unnumberedsubsecs' will appear in the same menu." ! (let ((case-fold-search t)) ! (if (re-search-forward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval ! (cdr (assoc level texinfo-update-menu-same-level-regexps)))) ! search-end ! t) ! (goto-char (match-beginning 1))))) (defun texinfo-copy-node-name () *************** *** 375,379 **** ! ;;;; Handling the old menu (defun texinfo-old-menu-p (beginning first) --- 401,405 ---- ! ;;; Handling the old menu (defun texinfo-old-menu-p (beginning first) *************** *** 398,409 **** Point must be at beginning of old menu. ! If the node-name of the new menu entry cannot be found in the old ! menu, use the new section title for the description, but if the ! node-name of the new menu is found in the old menu, replace the ! section title with the old description, whatever it may be. For this function, the new menu is a list made up of lists of dotted pairs in which the first element of the pair is the node name and the ! second element the description. The new menu is changed destructively. The old menu is the menu as it appears in the texinfo file." --- 424,433 ---- Point must be at beginning of old menu. ! If the node-name of the new menu is found in the old menu, insert the ! old description into the new entry. For this function, the new menu is a list made up of lists of dotted pairs in which the first element of the pair is the node name and the ! second element the description. The new menu is changed destructively. The old menu is the menu as it appears in the texinfo file." *************** *** 412,419 **** (while new-menu-list (save-excursion ; keep point at beginning of menu ! (if (search-forward ! (concat "\* " ; so only menu entries are found ! (car (car new-menu-list)) ! ":") ; so only complete entries are found end-of-menu t) --- 436,452 ---- (while new-menu-list (save-excursion ; keep point at beginning of menu ! (if (re-search-forward ! ;; Existing nodes can have the form ! ;; * NODE NAME:: DESCRIPTION ! ;; or ! ;; * MENU ITEM: NODE NAME. DESCRIPTION. ! ;; ! ;; Recognize both when looking for the description. ! (concat "\\* \\(" ; so only menu entries are found ! (car (car new-menu-list)) "::" ! "\\|" ! ".*: " (car (car new-menu-list)) "[.,\t\n]" ! "\\)" ! ) ; so only complete entries are found end-of-menu t) *************** *** 423,426 **** --- 456,500 ---- (setq new-menu-list new-menu-list-pointer))) + (defun texinfo-incorporate-menu-entry-names (new-menu-list) + "Copy any old menu entry names to the new menu. + + Point must be at beginning of old menu. + + If the node-name of the new menu entry cannot be found in the old + menu, do nothing. + + For this function, the new menu is a list made up of lists of dotted + pairs in which the first element of the pair is the node name and the + second element is the description (or nil). + + If we find an existing menu entry name, we change the first element of + the pair to be another dotted pair in which the car is the menu entry + name and the cdr is the node name. + + NEW-MENU-LIST is changed destructively. The old menu is the menu as it + appears in the texinfo file." + + (let ((new-menu-list-pointer new-menu-list) + (end-of-menu (texinfo-menu-end))) + (while new-menu-list + (save-excursion ; keep point at beginning of menu + (if (re-search-forward + ;; Existing nodes can have the form + ;; * NODE NAME:: DESCRIPTION + ;; or + ;; * MENU ITEM: NODE NAME. DESCRIPTION. + ;; + ;; We're interested in the second case. + (concat "\\* " ; so only menu entries are found + "\\(.*\\): " (car (car new-menu-list)) "[.,\t\n]") + end-of-menu + t) + (setcar + (car new-menu-list) ; replace the node name + (cons (buffer-substring (match-beginning 1) (match-end 1)) + (car (car new-menu-list))))) + (setq new-menu-list (cdr new-menu-list)))) + (setq new-menu-list new-menu-list-pointer))) + (defun texinfo-menu-copy-old-description (end-of-menu) "Return description field of old menu line as string. *************** *** 430,433 **** --- 504,508 ---- ;; don't copy a carriage return at line beginning with asterisk! ;; do copy a description that begins with an `@'! + ;; !! Known bug: does not copy descriptions starting with ^|\{?* etc. (if (and (looking-at "\\(\\w+\\|@\\)") (not (looking-at "\\(^\\* \\|^@end menu\\)"))) *************** *** 462,466 **** ! ;;;; Inserting new menu ;; try 32, but perhaps 24 is better --- 537,541 ---- ! ;;; Inserting new menu ;; try 32, but perhaps 24 is better *************** *** 476,503 **** \(\(\"node-name1\" . \"description\"\) ! \(\"node-name\" . \"description\"\) ... \) ! However, there does not need to be a description field." (insert "@menu\n") (while menu-list ! (if (cdr (car menu-list)) ; menu-list has description entry (progn ! (insert ! (format "* %s::" (car (car menu-list)))) ; node-name entry ! (indent-to texinfo-column-for-description 2) ! (insert ! (format "%s\n" (cdr (car menu-list))))) ; description entry ! ;; else menu-list lacks description entry ! (insert ! (format "* %s::\n" (car (car menu-list))))) ; node-name entry (setq menu-list (cdr menu-list))) (insert "@end menu") ! (message ! "Updated \"%s\" level menu following node: %s ... " ! level node-name)) ! ;;;; Handling description indentation ; Since the make-menu functions indent descriptions, these functions --- 551,672 ---- \(\(\"node-name1\" . \"description\"\) ! \(\"node-name2\" . \"description\"\) ... \) ! ! However, the description field might be nil. ! Also, the node-name field might itself be a dotted pair (call it P) of ! strings instead of just a string. In that case, the car of P ! is the menu entry name, and the cdr of P is the node name." (insert "@menu\n") (while menu-list ! ;; Every menu entry starts with a star and a space. ! (insert "* ") ! ! ;; Insert the node name (and menu entry name, if present). ! (let ((node-part (car (car menu-list)))) ! (if (stringp node-part) ! ;; "Double colon" entry line; menu entry and node name are the same, ! (insert (format "%s::" node-part)) ! ;; "Single colon" entry line; menu entry and node name are different. ! (insert (format "%s: %s." (car node-part) (cdr node-part))))) ! ! ;; Insert the description, if present. ! (if (cdr (car menu-list)) (progn ! ;; Move to right place. ! (indent-to texinfo-column-for-description 2) ! ;; Insert description. ! (insert (format "%s" (cdr (car menu-list)))))) ! ! (insert "\n") ; end this menu entry (setq menu-list (cdr menu-list))) (insert "@end menu") ! (message ! "Updated \"%s\" level menu following node: %s ... " level node-name)) ! ! ! ;;; Starting menu descriptions by inserting titles ! ! (defun texinfo-start-menu-description () ! "In this menu entry, insert the node's section title as a description. ! Position point at beginning of description ready for editing. ! Do not insert a title if the line contains an existing description. ! ! You will need to edit the inserted text since a useful description ! complements the node name rather than repeats it as a title does." ! ! (interactive) ! (let (beginning end node-name title) ! (save-excursion ! (beginning-of-line) ! (if (search-forward "* " (save-excursion (end-of-line) (point)) t) ! (progn (skip-chars-forward " \t") ! (setq beginning (point))) ! (error "This is not a line in a menu!")) ! ! (cond ! ;; "Double colon" entry line; menu entry and node name are the same, ! ((search-forward "::" (save-excursion (end-of-line) (point)) t) ! (if (looking-at "[ \t]*[^ \t\n]+") ! (error "Descriptive text already exists.")) ! (skip-chars-backward ": \t") ! (setq node-name (buffer-substring beginning (point)))) ! ! ;; "Single colon" entry line; menu entry and node name are different. ! ((search-forward ":" (save-excursion (end-of-line) (point)) t) ! (skip-chars-forward " \t") ! (setq beginning (point)) ! ;; Menu entry line ends in a period, comma, or tab. ! (if (re-search-forward "[.,\t]" ! (save-excursion (forward-line 1) (point)) t) ! (progn ! (if (looking-at "[ \t]*[^ \t\n]+") ! (error "Descriptive text already exists.")) ! (skip-chars-backward "., \t") ! (setq node-name (buffer-substring beginning (point)))) ! ;; Menu entry line ends in a return. ! (re-search-forward ".*\n" ! (save-excursion (forward-line 1) (point)) t) ! (skip-chars-backward " \t\n") ! (setq node-name (buffer-substring beginning (point))) ! (if (= 0 (length node-name)) ! (error "No node name on this line.") ! (insert ".")))) ! (t (error "No node name on this line."))) ! ;; Search for node that matches node name, and copy the section title. ! (if (re-search-forward ! (concat ! "^@node[ \t]+" ! node-name ! ".*\n" ; match node line ! "\\(" ! "\\(\\(^@c \\|^@comment\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)" ; ifinfo line, if any ! "\\)?") ! nil t) ! (progn ! (setq title ! (buffer-substring ! ;; skip over section type ! (progn (forward-word 1) ! ;; and over spaces ! (skip-chars-forward " \t") ! (point)) ! (progn (end-of-line) ! (skip-chars-backward " \t") ! (point))))) ! (error "Cannot find node to match node name in menu entry."))) ! ;; Return point to the menu and insert the title. ! (end-of-line) ! (delete-region ! (point) ! (save-excursion (skip-chars-backward " \t") (point))) ! (indent-to texinfo-column-for-description 2) ! (save-excursion (insert title)))) ! ;;; Handling description indentation ; Since the make-menu functions indent descriptions, these functions *************** *** 541,545 **** (beginning-of-line) (point))) ! (if (search-forward "::" (texinfo-menu-end) t) (progn (let ((beginning-white-space (point))) --- 710,717 ---- (beginning-of-line) (point))) ! ! (if (re-search-forward "\\* \\(.*::\\|.*: [^.,\t\n]+[.,\t]\\)" ! (texinfo-menu-end) ! t) (progn (let ((beginning-white-space (point))) *************** *** 555,559 **** ! ;;;; Making the master menu (defun texinfo-master-menu (update-all-nodes-menus-p) --- 727,731 ---- ! ;;; Making the master menu (defun texinfo-master-menu (update-all-nodes-menus-p) *************** *** 571,575 **** The function removes the detailed part of an already existing master ! menu. This action depends on the pre-existing master menu using the standard `texinfo-master-menu-header'. --- 743,747 ---- The function removes the detailed part of an already existing master ! menu. This action depends on the pre-exisitng master menu using the standard `texinfo-master-menu-header'. *************** *** 589,652 **** Each of the menus in the detailed node listing is introduced by the title of the section containing the menu." ! (interactive "P") ! (widen) ! (goto-char (point-min)) ! ! ;; Move point to location after `top'. ! (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)) ! (error "This buffer needs a Top node!")) ! ! (let ((first-chapter ! (save-excursion (re-search-forward "^@node") (point)))) ! (if (re-search-forward texinfo-master-menu-header first-chapter t) ! ;; Remove detailed master menu listing (progn ! (goto-char (match-beginning 0)) ! (let ((end-of-detailed-menu-descriptions ! (save-excursion ; beginning of end menu line ! (goto-char (texinfo-menu-end)) ! (beginning-of-line) (forward-char -1) ! (point)))) ! (delete-region (point) end-of-detailed-menu-descriptions))))) ! ! (if update-all-nodes-menus-p ! (progn ! (message "Making a master menu...first updating all nodes... ") ! (sleep-for 2) ! (mark-whole-buffer) ! (texinfo-update-node t) ! ! (message "Updating all menus... ") ! (sleep-for 2) ! (mark-whole-buffer) ! (texinfo-make-menu t))) ! ! (message "Now making the master menu... ") ! (sleep-for 2) ! (goto-char (point-min)) ! (texinfo-insert-master-menu-list ! (texinfo-master-menu-list)) ! ! ;; Remove extra newlines that texinfo-insert-master-menu-list ! ;; may have inserted. ! ! (save-excursion (goto-char (point-min)) ! (re-search-forward texinfo-master-menu-header) ! (goto-char (match-beginning 0)) ! (insert "\n") ! (delete-blank-lines) ! (re-search-backward "^@menu") ! (forward-line -1) ! (delete-blank-lines) ! (re-search-forward "^@end menu") ! (forward-line 1) ! (delete-blank-lines)) ! ! (message "Done...completed making master menu. You may save the buffer.")) (defun texinfo-master-menu-list () --- 761,834 ---- Each of the menus in the detailed node listing is introduced by the title of the section containing the menu." ! (interactive "P") ! (let ((case-fold-search t)) ! (widen) ! (goto-char (point-min)) ! ! ;; Move point to location after `top'. ! (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)) ! (error "This buffer needs a Top node!")) ! ! (let ((first-chapter ! (save-excursion ! (or (re-search-forward "^@node" nil t) ! (error "Too few nodes for a master menu!")) ! (point)))) ! (if (re-search-forward texinfo-master-menu-header first-chapter t) ! ;; Remove detailed master menu listing ! (progn ! (goto-char (match-beginning 0)) ! (let ((end-of-detailed-menu-descriptions ! (save-excursion ; beginning of end menu line ! (goto-char (texinfo-menu-end)) ! (beginning-of-line) (forward-char -1) ! (point)))) ! (delete-region (point) end-of-detailed-menu-descriptions))))) ! ! (if update-all-nodes-menus-p (progn ! (message "Making a master menu in %s ...first updating all nodes... " ! (buffer-name)) ! (sleep-for 2) ! (push-mark (point-max) t) ! (goto-char (point-min)) ! (texinfo-update-node t) ! ! (message "Updating all menus in %s ... " (buffer-name)) ! (sleep-for 2) ! (push-mark (point-max) t) ! (goto-char (point-min)) ! (texinfo-make-menu t))) ! ! (message "Now making the master menu in %s... " (buffer-name)) ! (sleep-for 2) (goto-char (point-min)) + (texinfo-insert-master-menu-list + (texinfo-master-menu-list)) ! ;; Remove extra newlines that texinfo-insert-master-menu-list ! ;; may have inserted. ! (save-excursion ! (goto-char (point-min)) ! ! (if (re-search-forward texinfo-master-menu-header nil t) ! (progn ! (goto-char (match-beginning 0)) ! (insert "\n") ! (delete-blank-lines) ! (goto-char (point-min)))) ! ! (re-search-forward "^@menu") ! (forward-line -1) ! (delete-blank-lines) ! ! (re-search-forward "^@end menu") ! (forward-line 1) ! (delete-blank-lines)) ! (message ! "Done...completed making master menu. You may save the buffer."))) (defun texinfo-master-menu-list () *************** *** 676,724 **** "Format and insert the master menu in the current buffer." (goto-char (point-min)) ! (re-search-forward "^@menu") (beginning-of-line) ! (delete-region (point) ; buffer must have ordinary top menu ! (save-excursion ! (re-search-forward "^@end menu") ! (point))) ! ! (save-excursion ; leave point at beginning of menu ! ;; Handle top of menu ! (insert "\n@menu\n") ! ;; Insert chapter menu entries ! (setq this-very-menu-list (reverse (car (car master-menu-list)))) ! ;;; Tell user what is going on. ! (message "Inserting chapter menu entry: %s ... " this-very-menu-list) ! (while this-very-menu-list ! (insert "* " (car this-very-menu-list) "\n") ! (setq this-very-menu-list (cdr this-very-menu-list))) ! (setq master-menu-list (cdr master-menu-list)) ! ! (insert texinfo-master-menu-header) ! ! ;; Now, insert all the other menus ! ! ;; The menu master-menu-list has a form like this: ! ;; ((("beta" "alpha") "title-A") ! ;; (("delta" "gamma") "title-B")) ! ! (while master-menu-list ! ! (message ! "Inserting menu for %s .... " (car (cdr (car master-menu-list)))) ! ;; insert title of menu section ! (insert "\n" (car (cdr (car master-menu-list))) "\n\n") ! ! ;; insert each menu entry (setq this-very-menu-list (reverse (car (car master-menu-list)))) (while this-very-menu-list (insert "* " (car this-very-menu-list) "\n") (setq this-very-menu-list (cdr this-very-menu-list))) ! (setq master-menu-list (cdr master-menu-list))) ! ! ;; Finish menu ! (insert "@end menu\n\n"))) (defvar texinfo-master-menu-header --- 858,915 ---- "Format and insert the master menu in the current buffer." (goto-char (point-min)) ! ;; Insert a master menu only after `Top' node and before next node ! ;; \(or include file if there is no next node\). ! (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)) ! (error "This buffer needs a Top node!")) ! (let ((first-chapter ! (save-excursion (re-search-forward "^@node\\|^@include") (point)))) ! (if (not (re-search-forward "^@menu" first-chapter t)) ! (error ! "Buffer lacks ordinary `Top' menu in which to insert master."))) (beginning-of-line) ! (delete-region ; buffer must have ordinary top menu ! (point) ! (save-excursion (re-search-forward "^@end menu") (point))) ! (save-excursion ; leave point at beginning of menu ! ;; Handle top of menu ! (insert "\n@menu\n") ! ;; Insert chapter menu entries (setq this-very-menu-list (reverse (car (car master-menu-list)))) + ;; Tell user what is going on. + (message "Inserting chapter menu entry: %s ... " this-very-menu-list) (while this-very-menu-list (insert "* " (car this-very-menu-list) "\n") (setq this-very-menu-list (cdr this-very-menu-list))) ! (setq master-menu-list (cdr master-menu-list)) ! ! ;; Only insert detailed master menu if there is one.... ! (if (car (car master-menu-list)) ! (insert texinfo-master-menu-header)) ! ! ;; Now, insert all the other menus ! ! ;; The menu master-menu-list has a form like this: ! ;; ((("beta" "alpha") "title-A") ! ;; (("delta" "gamma") "title-B")) ! ! (while master-menu-list ! ! (message ! "Inserting menu for %s .... " (car (cdr (car master-menu-list)))) ! ;; insert title of menu section ! (insert "\n" (car (cdr (car master-menu-list))) "\n\n") ! ! ;; insert each menu entry ! (setq this-very-menu-list (reverse (car (car master-menu-list)))) ! (while this-very-menu-list ! (insert "* " (car this-very-menu-list) "\n") ! (setq this-very-menu-list (cdr this-very-menu-list))) ! ! (setq master-menu-list (cdr master-menu-list))) ! ! ;; Finish menu ! (insert "@end menu\n\n"))) (defvar texinfo-master-menu-header *************** *** 737,755 **** If such a title cannot be found, return an empty string. Do not move point." ! (save-excursion ! (if (re-search-backward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval ! (cdr ! (assoc (texinfo-hierarchic-level) ! texinfo-update-menu-higher-regexps)))) ! nil ! t) ! (texinfo-copy-section-title) ! " "))) (defun texinfo-copy-menu () --- 928,949 ---- If such a title cannot be found, return an empty string. Do not move point." ! (let ((case-fold-search t)) ! (save-excursion ! (if (re-search-backward ! (concat ! "\\(^@top" ! "\\|" ; or ! texinfo-section-types-regexp ; all other section types ! "\\)") ! nil ! t) ! (progn ! (beginning-of-line) ! (forward-word 1) ; skip over section type ! (skip-chars-forward " \t") ; and over spaces ! (buffer-substring ! (point) ! (progn (end-of-line) (point)))) ! "")))) (defun texinfo-copy-menu () *************** *** 762,766 **** ; last `* ' entry (goto-char end-of-menu) ! (re-search-backward "^\* ") ; handle multi-line desc. (point)))) (while (< (point) last-entry) --- 956,962 ---- ; last `* ' entry (goto-char end-of-menu) ! ;; handle multi-line description ! (if (not (re-search-backward "^\* " nil t)) ! (error "No entries in menu.")) (point)))) (while (< (point) last-entry) *************** *** 779,783 **** ! ;;;; Determining the hierarchical level in the texinfo file (defun texinfo-specific-section-type () --- 975,979 ---- ! ;;; Determining the hierarchical level in the texinfo file (defun texinfo-specific-section-type () *************** *** 788,817 **** section whose type will be found. Does not move point. Signal an error if the node is not the top node and a section is not found." ! (save-excursion ! (cond ! ((re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" ! (save-excursion ! (end-of-line) ! (point)) ! t) ! "top") ! ((re-search-forward texinfo-section-types-regexp nil t) ! (buffer-substring (progn (beginning-of-line) ; copy its name ! (1+ (point))) ! (progn (forward-word 1) ! (point)))) ! (t ! (error ! "texinfo-specific-section-type: Chapter or section not found."))))) (defun texinfo-hierarchic-level () "Return the general hierarchal level of the next node in a texinfo file. Thus, a subheading or appendixsubsec is of type subsection." ! (cdr (assoc ! (texinfo-specific-section-type) ! texinfo-section-to-generic-alist))) ! ;;;; Locating the major positions (defun texinfo-update-menu-region-beginning (level) --- 984,1017 ---- section whose type will be found. Does not move point. Signal an error if the node is not the top node and a section is not found." ! (let ((case-fold-search t)) ! (save-excursion ! (cond ! ((re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" ! ;;; Following search limit by cph but causes a bug ! ;;; (save-excursion ! ;;; (end-of-line) ! ;;; (point)) ! nil ! t) ! "top") ! ((re-search-forward texinfo-section-types-regexp nil t) ! (buffer-substring (progn (beginning-of-line) ; copy its name ! (1+ (point))) ! (progn (forward-word 1) ! (point)))) ! (t ! (error ! "texinfo-specific-section-type: Chapter or section not found.")))))) (defun texinfo-hierarchic-level () "Return the general hierarchal level of the next node in a texinfo file. Thus, a subheading or appendixsubsec is of type subsection." ! (let ((case-fold-search t)) ! (cdr (assoc ! (texinfo-specific-section-type) ! texinfo-section-to-generic-alist)))) ! ;;; Locating the major positions (defun texinfo-update-menu-region-beginning (level) *************** *** 820,845 **** Thus, if this level is subsection, searches backwards for section node. Only argument is a string of the general type of section." ! ! (cond ! ((or (string-equal "top" level) ! (string-equal "chapter" level)) ! (save-excursion ! (goto-char (point-min)) ! (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t) ! (beginning-of-line) ! (point))) ! (t ! (save-excursion ! (re-search-backward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval ! (cdr (assoc level texinfo-update-menu-higher-regexps)))) ! nil ! 'goto-beginning) ! (point))))) (defun texinfo-update-menu-region-end (level) --- 1020,1048 ---- Thus, if this level is subsection, searches backwards for section node. Only argument is a string of the general type of section." ! (let ((case-fold-search t)) ! ;; !! Known bug: if section immediately follows top node, this ! ;; returns the beginning of the buffer as the beginning of the ! ;; higher level section. ! (cond ! ((or (string-equal "top" level) ! (string-equal "chapter" level)) ! (save-excursion ! (goto-char (point-min)) ! (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t) ! (beginning-of-line) ! (point))) ! (t ! (save-excursion ! (re-search-backward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval ! (cdr (assoc level texinfo-update-menu-higher-regexps)))) ! nil ! 'goto-beginning) ! (point)))))) (defun texinfo-update-menu-region-end (level) *************** *** 849,866 **** If level is top or chapter, returns end of file. Only argument is a string of the general type of section." ! ! (save-excursion ! (if (re-search-forward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval ! (cdr (assoc level texinfo-update-menu-higher-regexps)))) ! nil ! 'goto-end) ! (match-beginning 1) ! (point-max)))) (defun texinfo-menu-first-node (beginning end) --- 1052,1070 ---- If level is top or chapter, returns end of file. Only argument is a string of the general type of section." ! (let ((case-fold-search t)) ! (save-excursion ! (if (re-search-forward ! (concat ! "\\(^@node\\).*\n" ; match node line ! "\\(\\(\\(^@c\\).*\n\\)" ; match comment line, if any ! "\\|" ; or ! "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any ! (eval ! ;; Never finds end of level above chapter so goes to end. ! (cdr (assoc level texinfo-update-menu-higher-regexps)))) ! nil ! 'goto-end) ! (match-beginning 1) ! (point-max))))) (defun texinfo-menu-first-node (beginning end) *************** *** 881,885 **** ! ;;;; Alists and regular expressions for defining hierarchical levels (defvar texinfo-section-to-generic-alist --- 1085,1089 ---- ! ;;; Alists and regular expressions for defining hierarchical levels (defvar texinfo-section-to-generic-alist *************** *** 910,915 **** are strings of their corresponding general types.") (defvar texinfo-section-types-regexp ! "^@\\(chapter \\|sect\\|sub\\|unnum\\|major\\|chapheading \\|heading \\|appendix\\)" "Regexp matching chapter, section, other headings (but not the top node).") --- 1114,1120 ---- are strings of their corresponding general types.") + ;; We used to look for just sub, but that found @subtitle. (defvar texinfo-section-types-regexp ! "^@\\(chapter \\|sect\\|subs\\|subh\\|unnum\\|major\\|chapheading \\|heading \\|appendix\\)" "Regexp matching chapter, section, other headings (but not the top node).") *************** *** 1011,1015 **** ! ;;;; Updating a Node (defun texinfo-update-node (&optional region-p) --- 1216,1220 ---- ! ;;; Updating a node (defun texinfo-update-node (&optional region-p) *************** *** 1032,1040 **** The `texinfo-column-for-description' variable specifies the column to ! which menu descriptions are indented. Its default value is 24." (interactive "P") (if (not region-p) ! (let ((auto-fill-function nil)) ; update a single node (if (not (re-search-backward "^@node" (point-min) t)) (error "Node line not found before this position.")) --- 1237,1246 ---- The `texinfo-column-for-description' variable specifies the column to ! which menu descriptions are indented. Its default value is 32." (interactive "P") (if (not region-p) ! ;; update a single node ! (let ((auto-fill-function nil) (auto-fill-hook nil)) (if (not (re-search-backward "^@node" (point-min) t)) (error "Node line not found before this position.")) *************** *** 1043,1046 **** --- 1249,1253 ---- ;; else (let ((auto-fill-function nil) + (auto-fill-hook nil) (beginning (region-beginning)) (end (region-end))) *************** *** 1050,1054 **** (narrow-to-region beginning end) (goto-char beginning) ! (push-mark) (while (re-search-forward "^@node" (point-max) t) (beginning-of-line) --- 1257,1261 ---- (narrow-to-region beginning end) (goto-char beginning) ! (push-mark (point) t) (while (re-search-forward "^@node" (point-max) t) (beginning-of-line) *************** *** 1060,1064 **** (interactive) (save-excursion ! (mark-whole-buffer) (texinfo-update-node t) (message "Done...updated every node. You may save the buffer."))) --- 1267,1272 ---- (interactive) (save-excursion ! (push-mark (point-max) t) ! (goto-char (point-min)) (texinfo-update-node t) (message "Done...updated every node. You may save the buffer."))) *************** *** 1112,1121 **** Point must be at beginning of node line. Does not move point." (save-excursion ! (forward-word 1) ; skip over node command ! (skip-chars-forward " \t") ; and over spaces ! (if (not (looking-at "[^,\t\n ]+")) ; regexp based on what info looks for ! ; alternatively, use "[a-zA-Z]+" ! (let ((node-name (read-from-minibuffer "Node name: "))) ! (insert " " node-name))))) (defun texinfo-delete-existing-pointers () --- 1320,1334 ---- Point must be at beginning of node line. Does not move point." (save-excursion ! (let ((initial (texinfo-copy-next-section-title))) ! ;; This is not clean. Use `interactive' to read the arg. ! (forward-word 1) ; skip over node command ! (skip-chars-forward " \t") ; and over spaces ! (if (not (looking-at "[^,\t\n ]+")) ; regexp based on what Info looks for ! ; alternatively, use "[a-zA-Z]+" ! (let ((node-name ! (read-from-minibuffer ! "Node name (use no @, commas, colons, or apostrophes): " ! initial))) ! (insert " " node-name)))))) (defun texinfo-delete-existing-pointers () *************** *** 1145,1184 **** \(one of 'next, 'previous, or 'up\) specifies whether to find the `Next', `Previous', or `Up' pointer." ! ! (cond ((eq direction 'next) ! (forward-line 3) ; skip over current node ! (if (re-search-forward ! (eval ! (cdr (assoc level texinfo-update-menu-same-level-regexps))) ! end ! t) ! 'normal ! 'no-pointer)) ! ((eq direction 'previous) ! (if (re-search-backward ! (concat ! "\\(" ! (eval ! (cdr (assoc level texinfo-update-menu-same-level-regexps))) ! "\\|" ! (eval ! (cdr (assoc level texinfo-update-menu-higher-regexps))) ! "\\)") ! beginning ! t) ! 'normal ! 'no-pointer)) ! ((eq direction 'up) ! (if (re-search-backward ! (eval (cdr (assoc level texinfo-update-menu-higher-regexps))) ! (save-excursion ! (goto-char beginning) ! (beginning-of-line) ! (point)) ! t) ! 'normal ! 'no-pointer)) ! (t ! (error "texinfo-find-pointer: lack proper arguments")))) (defun texinfo-pointer-name (kind) --- 1358,1426 ---- \(one of 'next, 'previous, or 'up\) specifies whether to find the `Next', `Previous', or `Up' pointer." ! (let ((case-fold-search t)) ! (cond ((eq direction 'next) ! (forward-line 3) ; skip over current node ! ;; Search for section commands accompanied by node lines; ! ;; ignore section commands in the middle of nodes. ! (if (re-search-forward ! ;; A `Top' node is never a next pointer, so won't find it. ! (concat ! ;; Match node line. ! "\\(^@node\\).*\n" ! ;; Match comment or ifinfo line, if any ! "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?" ! (eval ! (cdr (assoc level texinfo-update-menu-same-level-regexps)))) ! end ! t) ! 'normal ! 'no-pointer)) ! ((eq direction 'previous) ! (if (re-search-backward ! (concat ! "\\(" ! ;; Match node line. ! "\\(^@node\\).*\n" ! ;; Match comment or ifinfo line, if any ! "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?" ! (eval ! (cdr (assoc level texinfo-update-menu-same-level-regexps))) ! "\\|" ! ;; Match node line. ! "\\(^@node\\).*\n" ! ;; Match comment or ifinfo line, if any ! "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?" ! (eval ! (cdr (assoc level texinfo-update-menu-higher-regexps))) ! "\\|" ! ;; Handle `Top' node specially. ! "^@node [ \t]*top[ \t]*\\(,\\|$\\)" ! "\\)") ! beginning ! t) ! 'normal ! 'no-pointer)) ! ((eq direction 'up) ! (if (re-search-backward ! (concat ! "\\(" ! ;; Match node line. ! "\\(^@node\\).*\n" ! ;; Match comment or ifinfo line, if any ! "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?" ! (eval (cdr (assoc level texinfo-update-menu-higher-regexps))) ! "\\|" ! ;; Handle `Top' node specially. ! "^@node [ \t]*top[ \t]*\\(,\\|$\\)" ! "\\)") ! (save-excursion ! (goto-char beginning) ! (beginning-of-line) ! (point)) ! t) ! 'normal ! 'no-pointer)) ! (t ! (error "texinfo-find-pointer: lack proper arguments"))))) (defun texinfo-pointer-name (kind) *************** *** 1222,1226 **** ! ;;;; Updating nodes sequentially ; These sequential update functions insert `Next' or `Previous' ; pointers that point to the following or preceding nodes even if they --- 1464,1468 ---- ! ;;; Updating nodes sequentially ; These sequential update functions insert `Next' or `Previous' ; pointers that point to the following or preceding nodes even if they *************** *** 1250,1254 **** (interactive "P") (if (not region-p) ! (let ((auto-fill-function nil)) ; update a single node (if (not (re-search-backward "^@node" (point-min) t)) (error "Node line not found before this position.")) --- 1492,1497 ---- (interactive "P") (if (not region-p) ! ;; update a single node ! (let ((auto-fill-function nil) (auto-fill-hook nil)) (if (not (re-search-backward "^@node" (point-min) t)) (error "Node line not found before this position.")) *************** *** 1258,1261 **** --- 1501,1505 ---- ;; else (let ((auto-fill-function nil) + (auto-fill-hook nil) (beginning (region-beginning)) (end (region-end))) *************** *** 1265,1269 **** (narrow-to-region beginning end) (goto-char beginning) ! (push-mark) (while (re-search-forward "^@node" (point-max) t) (beginning-of-line) --- 1509,1513 ---- (narrow-to-region beginning end) (goto-char beginning) ! (push-mark (point) t) (while (re-search-forward "^@node" (point-max) t) (beginning-of-line) *************** *** 1307,1335 **** 'previous, or 'up) specifies whether to find the `Next', `Previous', or `Up' pointer." ! ! (cond ((eq direction 'next) ! (forward-line 3) ; skip over current node ! (if (re-search-forward ! texinfo-section-types-regexp ! (point-max) ! t) ! 'normal ! 'no-pointer)) ! ((eq direction 'previous) ! (if (re-search-backward ! texinfo-section-types-regexp ! (point-min) ! t) ! 'normal ! 'no-pointer)) ! ((eq direction 'up) ! (if (re-search-backward ! (eval (cdr (assoc level texinfo-update-menu-higher-regexps))) ! beginning ! t) ! 'normal ! 'no-pointer)) ! (t ! (error "texinfo-sequential-find-pointer: lack proper arguments")))) (defun texinfo-sequentially-insert-pointer (level direction) --- 1551,1579 ---- 'previous, or 'up) specifies whether to find the `Next', `Previous', or `Up' pointer." ! (let ((case-fold-search t)) ! (cond ((eq direction 'next) ! (forward-line 3) ; skip over current node ! (if (re-search-forward ! texinfo-section-types-regexp ! (point-max) ! t) ! 'normal ! 'no-pointer)) ! ((eq direction 'previous) ! (if (re-search-backward ! texinfo-section-types-regexp ! (point-min) ! t) ! 'normal ! 'no-pointer)) ! ((eq direction 'up) ! (if (re-search-backward ! (eval (cdr (assoc level texinfo-update-menu-higher-regexps))) ! beginning ! t) ! 'normal ! 'no-pointer)) ! (t ! (error "texinfo-sequential-find-pointer: lack proper arguments"))))) (defun texinfo-sequentially-insert-pointer (level direction) *************** *** 1349,1413 **** ! ;;;; Inserting `@node' lines ; The `texinfo-insert-node-lines' function inserts `@node' lines as needed ; before the `@chapter', `@section', and such like lines of a region ; in a Texinfo file. ! (defun texinfo-insert-node-lines (&optional title-p) "Insert missing `@node' lines in region of Texinfo file. Non-nil argument (prefix, if interactive) means also to insert the section titles as node names; and also to insert the section titles as node names in pre-existing @node lines that lack names." ! (interactive "P") ! (save-excursion ! (let ((begin-region (region-beginning)) ! (end-region (region-end))) ! (goto-char begin-region) ! (while (< (point) end-region) ! (re-search-forward texinfo-section-types-regexp nil 'end) ! ;; copy title, since most often, we will need it ! (let ((title ! (progn ! (beginning-of-line) ! (forward-word 1) ! (skip-chars-forward " \t") ! (buffer-substring ! (point) ! (save-excursion (end-of-line) (point)))))) ! ;; insert a node if necessary ! (if (re-search-backward ! "^@node" ! (save-excursion ! (forward-line -3) ! (point)) ! t) ! ;; @node present, and point at beginning of that line ! (forward-word 1) ! ;; else @node missing, insert one ! (progn ! (beginning-of-line) ; beginning of `@section' line ! (insert "@node\n") ! (backward-char 1))) ; leave point just after `@node' ! ;; insert a title if warranted ! (if title-p ! (progn ! (skip-chars-forward " \t") ! ;; use regexp based on what info looks for ! ;; (alternatively, use "[a-zA-Z]+") ! (if (not (looking-at "[^,\t\n ]+")) ! (progn ! (beginning-of-line) ! (forward-word 1) ! (insert " " title) ! (message "Inserted title %s ... " title))))) ! ;; in any case, go forward beyond current section title ! (forward-line 3))))) ! (if title-p (message "Done inserting node lines and titles. You may save the buffer.") ! (message "Done inserting node lines. You may save the buffer."))) ! ;;;; Update and create menus for multi-file Texinfo sources ;; 1. M-x texinfo-multiple-files-update --- 1593,1672 ---- ! ;;; Inserting `@node' lines ; The `texinfo-insert-node-lines' function inserts `@node' lines as needed ; before the `@chapter', `@section', and such like lines of a region ; in a Texinfo file. ! (defun texinfo-insert-node-lines (beginning end &optional title-p) "Insert missing `@node' lines in region of Texinfo file. Non-nil argument (prefix, if interactive) means also to insert the section titles as node names; and also to insert the section titles as node names in pre-existing @node lines that lack names." ! (interactive "r\nP") ! ! ;; Use marker; after inserting node lines, leave point at end of ! ;; region and mark at beginning. ! ! (let (beginning-marker end-marker title last-section-position) ! ! ;; Save current position on mark ring and set mark to end. ! (push-mark end t) ! (setq end-marker (mark-marker)) ! ! (goto-char beginning) ! (while (re-search-forward ! texinfo-section-types-regexp ! end-marker ! 'end) ! ;; Copy title if desired. ! (if title-p ! (progn ! (beginning-of-line) ! (forward-word 1) ! (skip-chars-forward " \t") ! (setq title (buffer-substring ! (point) ! (save-excursion (end-of-line) (point)))))) ! ;; Insert node line if necessary. ! (if (re-search-backward ! "^@node" ! ;; Avoid finding previous node line if node lines are close. ! (or last-section-position ! (save-excursion (forward-line -2) (point))) t) ! ;; @node is present, and point at beginning of that line ! (forward-word 1) ; Leave point just after @node. ! ;; Else @node missing; insert one. ! (beginning-of-line) ; Beginning of `@section' line. ! (insert "@node\n") ! (backward-char 1)) ; Leave point just after `@node'. ! ;; Insert title if desired. ! (if title-p ! (progn ! (skip-chars-forward " \t") ! ;; Use regexp based on what info looks for ! ;; (alternatively, use "[a-zA-Z]+"); ! ;; this means we only insert a title if none exists. ! (if (not (looking-at "[^,\t\n ]+")) ! (progn ! (beginning-of-line) ! (forward-word 1) ! (insert " " title) ! (message "Inserted title %s ... " title))))) ! ;; Go forward beyond current section title. ! (re-search-forward texinfo-section-types-regexp ! (save-excursion (forward-line 3) (point)) t) ! (setq last-section-position (point)) ! (forward-line 1)) ! ! ;; Leave point at end of region, mark at beginning. ! (set-mark beginning) ! ! (if title-p (message "Done inserting node lines and titles. You may save the buffer.") ! (message "Done inserting node lines. You may save the buffer.")))) ! ;;; Update and create menus for multi-file Texinfo sources ;; 1. M-x texinfo-multiple-files-update *************** *** 1438,1442 **** ! ;;;; Auxiliary functions for multiple file updating (defun texinfo-multi-file-included-list (outer-file) --- 1697,1701 ---- ! ;;; Auxiliary functions for multiple file updating (defun texinfo-multi-file-included-list (outer-file) *************** *** 1466,1488 **** (save-excursion (end-of-line) ! (let ((section-end (or (save-excursion ! (re-search-forward "\\(^@node\\)" nil t) ! (match-beginning 0)) (point-max)))) ! (if (re-search-forward texinfo-section-types-regexp section-end t) ! ;; copy title ! (let ((title ! (buffer-substring ! (progn (forward-word 1) ; skip over section type ! (skip-chars-forward " \t") ; and over spaces ! (point)) ! (progn (end-of-line) (point))))) ! title) "")))) (defun texinfo-multi-file-update (files &optional update-everything) "Update first node pointers in each file in FILES. ! Return a list of the node names and the title immediate following them. The first file in the list is an outer file; the remaining are --- 1725,1749 ---- (save-excursion (end-of-line) ! (let ((node-end (or (save-excursion ! (if (re-search-forward "\\(^@node\\)" nil t) ! (match-beginning 0))) (point-max)))) ! (if (re-search-forward texinfo-section-types-regexp node-end t) ! (progn ! (beginning-of-line) ! ;; copy title ! (let ((title ! (buffer-substring ! (progn (forward-word 1) ; skip over section type ! (skip-chars-forward " \t") ; and over spaces ! (point)) ! (progn (end-of-line) (point))))) ! title)) "")))) (defun texinfo-multi-file-update (files &optional update-everything) "Update first node pointers in each file in FILES. ! Return a list of the node names. The first file in the list is an outer file; the remaining are *************** *** 1503,1516 **** Thus, normally, each included file contains one, and only one, ! chapter. ! ! The menu-list has the form: ! ! \(\(\"node-name1\" . \"title1\"\) ! \(\"node-name2\" . \"title2\"\) ... \) ! However, there does not need to be a title field." ! (let (menu-list) ;; Find the name of the first node of the first included file. --- 1764,1781 ---- Thus, normally, each included file contains one, and only one, ! chapter." ! ; The menu-list has the form: ! ; ! ; \(\(\"node-name1\" . \"title1\"\) ! ; \(\"node-name2\" . \"title2\"\) ... \) ! ; ! ; However, there does not need to be a title field and this function ! ; does not fill it; however a comment tells you how to do so. ! ; You would use the title field if you wanted to insert titles in the ! ; description slot of a menu as a description. ! (let ((case-fold-search t) ! menu-list) ;; Find the name of the first node of the first included file. *************** *** 1527,1533 **** (cons (cons next-node-name ! (texinfo-copy-next-section-title)) menu-list)) ! ;; Go to outer file (switch-to-buffer (find-file-noselect (car files))) --- 1792,1800 ---- (cons (cons next-node-name ! (prog1 "" (forward-line 1))) ! ;; Use following to insert section titles automatically. ! ;; (texinfo-copy-next-section-title) menu-list)) ! ;; Go to outer file (switch-to-buffer (find-file-noselect (car files))) *************** *** 1561,1565 **** (cons (cons next-node-name ! (texinfo-copy-next-section-title)) menu-list))) --- 1828,1834 ---- (cons (cons next-node-name ! (prog1 "" (forward-line 1))) ! ;; Use following to insert section titles automatically. ! ;; (texinfo-copy-next-section-title) menu-list))) *************** *** 1570,1573 **** --- 1839,1847 ---- (error "No `@node' line found in %s !" (buffer-name))) (beginning-of-line) + + ;; Update other menus and nodes if requested. + (if update-everything (texinfo-all-menus-update t)) + + (beginning-of-line) (texinfo-delete-existing-pointers) (end-of-line) *************** *** 1577,1583 **** (setq previous-node-name (texinfo-copy-node-name)) - ;; Update other menus and nodes if requested. - (if update-everything (texinfo-all-menus-update t)) - (setq files (cdr files))) (nreverse menu-list))) --- 1851,1854 ---- *************** *** 1590,1607 **** (insert "@menu\n") (while menu-list ! (if (cdr (car menu-list)) ; menu-list has description entry (progn ! (insert ! (format "* %s::" (car (car menu-list)))) ; node-name entry ! (indent-to texinfo-column-for-description 2) ! (insert ! (format "%s\n" (cdr (car menu-list))))) ; description entry ! ;; else menu-list lacks description entry ! (insert ! (format "* %s::\n" (car (car menu-list))))) ; node-name entry (setq menu-list (cdr menu-list))) (insert "@end menu")) - (defun texinfo-multi-file-master-menu-list (files-list) "Return master menu list from files in FILES-LIST. --- 1861,1887 ---- (insert "@menu\n") (while menu-list ! ;; Every menu entry starts with a star and a space. ! (insert "* ") ! ! ;; Insert the node name (and menu entry name, if present). ! (let ((node-part (car (car menu-list)))) ! (if (stringp node-part) ! ;; "Double colon" entry line; menu entry and node name are the same, ! (insert (format "%s::" node-part)) ! ;; "Single colon" entry line; menu entry and node name are different. ! (insert (format "%s: %s." (car node-part) (cdr node-part))))) ! ! ;; Insert the description, if present. ! (if (cdr (car menu-list)) (progn ! ;; Move to right place. ! (indent-to texinfo-column-for-description 2) ! ;; Insert description. ! (insert (format "%s" (cdr (car menu-list)))))) ! ! (insert "\n") ; end this menu entry (setq menu-list (cdr menu-list))) (insert "@end menu")) (defun texinfo-multi-file-master-menu-list (files-list) "Return master menu list from files in FILES-LIST. *************** *** 1622,1643 **** ! ;;;; The multiple-file update function (defun texinfo-multiple-files-update (outer-file &optional update-everything make-master-menu) "Update first node pointers in each file included in OUTER-FILE; ! create or update main menu in the outer file that refers to such nodes. ! This does not create or update menus or pointers within the included files. With optional MAKE-MASTER-MENU argument (prefix arg, if interactive), ! insert a master menu in OUTER-FILE. This does not create or update ! menus or pointers within the included files. With optional UPDATE-EVERYTHING argument (numeric prefix arg, if interactive), update all the menus and all the `Next', `Previous', and `Up' pointers of all the files included in OUTER-FILE before inserting ! a master menu in OUTER-FILE. ! ! The command also updates the `Top' level node pointers of OUTER-FILE. Notes: --- 1902,1926 ---- ! ;;; The multiple-file update function (defun texinfo-multiple-files-update (outer-file &optional update-everything make-master-menu) "Update first node pointers in each file included in OUTER-FILE; ! create or update the `Top' level node pointers and the main menu in ! the outer file that refers to such nodes. This does not create or ! update menus or pointers within the included files. With optional MAKE-MASTER-MENU argument (prefix arg, if interactive), ! insert a master menu in OUTER-FILE in addition to creating or updating ! pointers in the first @node line in each included file and creating or ! updating the `Top' level node pointers of the outer file. This does ! not create or update other menus and pointers within the included ! files. With optional UPDATE-EVERYTHING argument (numeric prefix arg, if interactive), update all the menus and all the `Next', `Previous', and `Up' pointers of all the files included in OUTER-FILE before inserting ! a master menu in OUTER-FILE. Also, update the `Top' level node ! pointers of OUTER-FILE. Notes: *************** *** 1659,1668 **** Thus, normally, each included file contains one, and only one, chapter." ! ! (interactive "fName of outer `include' file: ") ! ! (cond (current-prefix-arg ! (setq make-master-menu (listp current-prefix-arg)) ! (setq update-everything (numberp current-prefix-arg)))) (let* ((included-file-list (texinfo-multi-file-included-list outer-file)) --- 1942,1957 ---- Thus, normally, each included file contains one, and only one, chapter." ! ! (interactive (cons ! (read-string ! "Name of outer `include' file: " ! (buffer-file-name)) ! (cond ((not current-prefix-arg) ! '(nil nil)) ! ((listp current-prefix-arg) ! '(t nil)) ; make-master-menu ! ((numberp current-prefix-arg) ! '(t t)) ; update-everything ! ))) (let* ((included-file-list (texinfo-multi-file-included-list outer-file)) *************** *** 1721,1728 **** ;; Create a master menu and insert it (texinfo-insert-master-menu-list ! (texinfo-multi-file-master-menu-list included-file-list))))) (message "Multiple files updated.")) (provide 'texnfo-upd) --- 2010,2034 ---- ;; Create a master menu and insert it (texinfo-insert-master-menu-list ! (texinfo-multi-file-master-menu-list included-file-list))))) + + ;; Remove unwanted extra lines. + (save-excursion + (goto-char (point-min)) + + (re-search-forward "^@menu") + (forward-line -1) + (insert "\n") ; Ensure at least one blank line. + (delete-blank-lines) + + (re-search-forward "^@end menu") + (forward-line 1) + (insert "\n") ; Ensure at least one blank line. + (delete-blank-lines)) + (message "Multiple files updated.")) + + ;;; Place `provide' at end of file. (provide 'texnfo-upd) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/time.el emacs-19.17/lisp/time.el *** emacs-19.16/lisp/time.el Fri Jun 4 15:20:12 1993 --- emacs-19.17/lisp/time.el Wed Jul 7 00:31:23 1993 *************** *** 1,5 **** ;;; time.el --- display time and load in mode line of Emacs. ! ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. ;; Maintainer: FSF --- 1,5 ---- ;;; time.el --- display time and load in mode line of Emacs. ! ;; Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc. ;; Maintainer: FSF *************** *** 129,135 **** (defun display-time-file-nonempty-p (file) ! (while (file-symlink-p file) ! (setq file (file-symlink-p file))) ! (> (nth 7 (file-attributes file)) 0)) ;;; time.el ends here --- 129,133 ---- (defun display-time-file-nonempty-p (file) ! (< 0 (nth 7 (file-attributes (file-chase-links file))))) ;;; time.el ends here diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/vc-hooks.el emacs-19.17/lisp/vc-hooks.el *** emacs-19.16/lisp/vc-hooks.el Tue Jul 6 02:18:31 1993 --- emacs-19.17/lisp/vc-hooks.el Thu Jul 15 01:48:50 1993 *************** *** 1,5 **** ;;; vc-hooks.el --- resident support for version-control ! ;; Copyright (C) 1992 Free Software Foundation, Inc. ;; Author: Eric S. Raymond --- 1,5 ---- ;;; vc-hooks.el --- resident support for version-control ! ;; Copyright (C) 1992, 1993 Free Software Foundation, Inc. ;; Author: Eric S. Raymond *************** *** 153,161 **** (defun vc-rcs-status (file) ! ;; Return string " [LOCKER:REV]" if FILE under RCS control, otherwise nil, ! ;; for placement in modeline by `vc-mode-line'. ! ! ;; If FILE is not locked then return just "". If the FILE is locked ! ;; then return *all* the locks currently set, in a single string of the ;; form " LOCKER1:REV1 LOCKER2:REV2 ...". --- 153,161 ---- (defun vc-rcs-status (file) ! ;; Return string for placement in modeline by `vc-mode-line'. ! ;; If FILE is not registered under RCS, return nil. ! ;; If FILE is registered but not locked, return " REV" if there is a head ! ;; revision and " @@" otherwise. ! ;; If FILE is locked then return all locks in a string of the ;; form " LOCKER1:REV1 LOCKER2:REV2 ...". *************** *** 167,176 **** ;; buffer. ;; ! ;; 3. Search work buffer for line starting with "date" indicating enough ! ;; of header was included; if not found, then keep inserting characters ! ;; until "date" is located. ;; ! ;; 4. Search work buffer for line starting with "locks", extract ! ;; all the locks currently enabled, and remove control characters ;; separating them, like newlines; the string " user1:revision1 ;; user2:revision2 ..." is returned. --- 167,174 ---- ;; buffer. ;; ! ;; 3. Search work buffer for "locks...;" phrase; if not found, then ! ;; keep inserting more characters until the phrase is found. ;; ! ;; 4. Extract the locks, and remove control characters ;; separating them, like newlines; the string " user1:revision1 ;; user2:revision2 ..." is returned. *************** *** 180,186 **** ;; The output doesn't show which version you are actually looking at. ;; The modeline can get quite cluttered when there are multiple locks. (let ((master (vc-name file)) ! found status) ;; If master file exists, then parse its contents, otherwise we return the --- 178,185 ---- ;; The output doesn't show which version you are actually looking at. ;; The modeline can get quite cluttered when there are multiple locks. + ;; The head revision is probably not what you want if you've used `rcs -b'. (let ((master (vc-name file)) ! found) ;; If master file exists, then parse its contents, otherwise we return the *************** *** 190,194 **** ;; Create work buffer. ! (set-buffer (get-buffer-create "*vc-rcs-status*")) (setq buffer-read-only nil default-directory (file-name-directory master)) --- 189,193 ---- ;; Create work buffer. ! (set-buffer (get-buffer-create " *vc-rcs-status*")) (setq buffer-read-only nil default-directory (file-name-directory master)) *************** *** 208,218 **** (if found ;; Clean control characters from text. ! (let ((status ! (save-restriction ! (narrow-to-region (match-beginning 1) (match-end 1)) ! (goto-char (point-min)) ! (while (re-search-forward "[ \b\t\n\v\f\r]+" nil t) ! (replace-match " " t t)) ! (buffer-string)))) ;; Clean work buffer. (erase-buffer) --- 207,225 ---- (if found ;; Clean control characters from text. ! (let* ((locks ! (save-restriction ! (narrow-to-region (match-beginning 1) (match-end 1)) ! (goto-char (point-min)) ! (while (re-search-forward "[ \b\t\n\v\f\r]+" nil t) ! (replace-match " " t t)) ! (buffer-string))) ! (status ! (if (not (string-equal locks "")) ! locks ! (goto-char (point-min)) ! (if (looking-at "head[ \b\t\n\v\f\r]+\\([.0-9]+\\)") ! (concat " " (buffer-substring (match-beginning 1) ! (match-end 1))) ! " @@")))) ;; Clean work buffer. (erase-buffer) diff -rc2P --exclude-from=exceptions emacs-19.16/lisp/view.el emacs-19.17/lisp/view.el *** emacs-19.16/lisp/view.el Thu Jun 3 02:34:56 1993 --- emacs-19.17/lisp/view.el Sat Jul 17 15:04:47 1993 *************** *** 107,111 **** For list of all View commands, type ? or h while viewing. ! Calls the value of view-hook if that is non-nil." (interactive "fView file: ") (let ((old-buf (current-buffer)) --- 107,111 ---- For list of all View commands, type ? or h while viewing. ! This command runs the normal hook `view-hook'." (interactive "fView file: ") (let ((old-buf (current-buffer)) *************** *** 127,131 **** For list of all View commands, type ? or h while viewing. ! Calls the value of view-hook if that is non-nil." (interactive "fView file: ") (let ((old-arrangement (current-window-configuration)) --- 127,131 ---- For list of all View commands, type ? or h while viewing. ! This command runs the normal hook `view-hook'." (interactive "fView file: ") (let ((old-arrangement (current-window-configuration)) *************** *** 146,150 **** For list of all View commands, type ? or h while viewing. ! Calls the value of view-hook if that is non-nil." (interactive "bView buffer: ") (let ((old-buf (current-buffer))) --- 146,150 ---- For list of all View commands, type ? or h while viewing. ! This command runs the normal hook `view-hook'." (interactive "bView buffer: ") (let ((old-buf (current-buffer))) *************** *** 155,161 **** (defun view-buffer-other-window (buffer-name not-return) "View BUFFER in View mode in another window, ! returning to original buffer when done ONLY if ! prefix argument not-return is nil (as by default). ! The usual Emacs commands are not available; instead, a special set of commands (mostly letters and punctuation) are defined for moving around in the buffer. --- 155,162 ---- (defun view-buffer-other-window (buffer-name not-return) "View BUFFER in View mode in another window, ! returning to original buffer when done *only* if ! prefix argument NOT-RETURN is nil (which is the default). ! ! The usual Emacs commands are not available in View mode; instead, a special set of commands (mostly letters and punctuation) are defined for moving around in the buffer. *************** *** 163,167 **** For list of all View commands, type ? or h while viewing. ! Calls the value of view-hook if that is non-nil." (interactive "bView buffer:\nP") (let ((return-to (and not-return (current-window-configuration)))) --- 164,168 ---- For list of all View commands, type ? or h while viewing. ! This command runs the normal hook `view-hook'." (interactive "bView buffer:\nP") (let ((return-to (and not-return (current-window-configuration)))) *************** *** 205,209 **** q or C-c exit view-mode and return to previous buffer. ! Entry to this mode calls the value of view-hook if non-nil. \\{view-mode-map}" ; Not interactive because dangerous things happen --- 206,211 ---- q or C-c exit view-mode and return to previous buffer. ! Entry to this mode runs the normal hook `view-hook'. ! \\{view-mode-map}" ; Not interactive because dangerous things happen *************** *** 302,306 **** (defvar view-hook nil ! "If non-nil, its value is called when viewing buffer or file.") ;(defun view-last-command (&optional who what) --- 304,308 ---- (defvar view-hook nil ! "Normal hook run when starting to view a buffer or file.") ;(defun view-last-command (&optional who what) *************** *** 318,322 **** (defun View-goto-line (&optional line) ! "Move to LINE in View mode. Display is centered at LINE. Sets mark at starting position and pushes mark ring." --- 320,324 ---- (defun View-goto-line (&optional line) ! "Move to line LINE in View mode. Display is centered at LINE. Sets mark at starting position and pushes mark ring." *************** *** 380,385 **** (- (view-scroll-size))))) ! (defun View-search-regexp-forward (times regexp) ! "Search forward for NTH occurrence of REGEXP in View mode. Displays line found at center of window. REGEXP is remembered for searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward]. Sets mark at starting position and pushes mark ring." --- 382,387 ---- (- (view-scroll-size))))) ! (defun View-search-regexp-forward (n regexp) ! "Search forward for Nth occurrence of REGEXP. Displays line found at center of window. REGEXP is remembered for searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward]. Sets mark at starting position and pushes mark ring." *************** *** 387,413 **** (if (> (length regexp) 0) (progn ! ;(view-last-command 'View-search-last-regexp-forward times) ! (view-search times regexp)))) ! (defun View-search-regexp-backward (times regexp) ! "Search backward from window start for NTH instance of REGEXP in View mode. Displays line found at center of window. REGEXP is remembered for searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward]. Sets mark at starting position and pushes mark ring." (interactive "p\nsSearch backward (regexp): ") ! (View-search-regexp-forward (- times) regexp)) ! (defun View-search-last-regexp-forward (times) ! "Search forward from window end for NTH instance of last regexp in View mode. Displays line found at center of window. Sets mark at starting position and pushes mark ring." (interactive "p") ! (View-search-regexp-forward times view-last-regexp)) ! (defun View-search-last-regexp-backward (times) ! "Search backward from window start for NTH instance of last regexp in View mode. Displays line found at center of window. Sets mark at starting position and pushes mark ring." (interactive "p") ! (View-search-regexp-backward times view-last-regexp)) (defun View-back-to-mark (&optional ignore) --- 389,415 ---- (if (> (length regexp) 0) (progn ! ;(view-last-command 'View-search-last-regexp-forward n) ! (view-search n regexp)))) ! (defun View-search-regexp-backward (n regexp) ! "Search backward from window start for Nth instance of REGEXP. Displays line found at center of window. REGEXP is remembered for searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward]. Sets mark at starting position and pushes mark ring." (interactive "p\nsSearch backward (regexp): ") ! (View-search-regexp-forward (- n) regexp)) ! (defun View-search-last-regexp-forward (n) ! "Search forward from window end for Nth instance of last regexp. Displays line found at center of window. Sets mark at starting position and pushes mark ring." (interactive "p") ! (View-search-regexp-forward n view-last-regexp)) ! (defun View-search-last-regexp-backward (n) ! "Search backward from window start for Nth instance of last regexp. Displays line found at center of window. Sets mark at starting position and pushes mark ring." (interactive "p") ! (View-search-regexp-backward n view-last-regexp)) (defun View-back-to-mark (&optional ignore) diff -rc2P --exclude-from=exceptions emacs-19.16/make-dist emacs-19.17/make-dist *** emacs-19.16/make-dist Thu Jun 17 20:49:13 1993 --- emacs-19.17/make-dist Wed Jul 7 05:57:09 1993 *************** *** 146,150 **** # I think we're not going to distribute anything in external-lisp, so # I've removed it from this list. ! for subdir in lisp lisp/term lisp/forms-mode site-lisp \ src src/m src/s src/bitmaps lib-src oldXMenu \ etc lock cpp info man shortnames vms; do --- 146,150 ---- # I think we're not going to distribute anything in external-lisp, so # I've removed it from this list. ! for subdir in lisp lisp/term site-lisp \ src src/m src/s src/bitmaps lib-src oldXMenu \ etc lock cpp info man shortnames vms; do diff -rc2P --exclude-from=exceptions emacs-19.16/man/ChangeLog emacs-19.17/man/ChangeLog *** emacs-19.16/man/ChangeLog Tue Jul 6 11:08:01 1993 --- emacs-19.17/man/ChangeLog Mon Jul 19 02:03:28 1993 *************** *** 1,2 **** --- 1,10 ---- + Mon Jul 19 02:03:20 1993 Richard Stallman (rms@sugar-bombs.gnu.ai.mit.edu) + + * Version 19.17 released. + + Sat Jul 10 16:16:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * split-man: Fix typos in last change. + Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) diff -rc2P --exclude-from=exceptions emacs-19.16/man/emacs.texi emacs-19.17/man/emacs.texi *** emacs-19.16/man/emacs.texi Tue Jul 6 11:09:59 1993 --- emacs-19.17/man/emacs.texi Sun Jul 18 04:10:29 1993 *************** *** 111,115 **** display editor. This Info file describes how to edit with Emacs and some of how to customize it, but not how to extend it. It ! corresponds to GNU Emacs version 19.16. @end ifinfo --- 111,115 ---- display editor. This Info file describes how to edit with Emacs and some of how to customize it, but not how to extend it. It ! corresponds to GNU Emacs version 19.17. @end ifinfo *************** *** 809,817 **** development, write for a copy of AI memo 519a, ``Emacs, the Extensible, Customizable Self-Documenting Display Editor'', to Publications Department, ! Artificial Intelligence Lab, 545 Tech Square, Cambridge, MA 02139, USA. At last report they charge $2.25 per copy. Another useful publication is LCS TM-165, ``A Cookbook for an Emacs'', by Craig Finseth, available from Publications Department, Laboratory for Computer Science, 545 Tech Square, ! Cambridge, MA 02139, USA. The price today is $3. This edition of the manual is intended for use with GNU Emacs installed on --- 809,817 ---- development, write for a copy of AI memo 519a, ``Emacs, the Extensible, Customizable Self-Documenting Display Editor'', to Publications Department, ! Artificial Intelligence Lab, 545 Tech Square, Cambridge, MA 02139, USA@. At last report they charge $2.25 per copy. Another useful publication is LCS TM-165, ``A Cookbook for an Emacs'', by Craig Finseth, available from Publications Department, Laboratory for Computer Science, 545 Tech Square, ! Cambridge, MA 02139, USA@. The price today is $3. This edition of the manual is intended for use with GNU Emacs installed on *************** *** 851,855 **** You can also order copies of GNU Emacs from the Free Software ! Foundation, on various magnetic media or on CD-ROM. This is a convenient and reliable way to get a copy; it is also a good way to help fund our work. (The Foundation has always received most of its funds in --- 851,855 ---- You can also order copies of GNU Emacs from the Free Software ! Foundation, on various magnetic media or on CD-ROM@. This is a convenient and reliable way to get a copy; it is also a good way to help fund our work. (The Foundation has always received most of its funds in *************** *** 1172,1181 **** @item BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY ! FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM ``AS IS'' WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF ! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS ! TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. --- 1172,1181 ---- @item BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY ! FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW@. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM ``AS IS'' WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF ! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE@. THE ENTIRE RISK AS ! TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU@. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. *************** *** 1223,1227 **** 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. --- 1223,1227 ---- 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. diff -rc2P --exclude-from=exceptions emacs-19.16/man/files.texi emacs-19.17/man/files.texi *** emacs-19.16/man/files.texi Thu Jun 17 18:04:50 1993 --- emacs-19.17/man/files.texi Sun Jul 18 03:35:33 1993 *************** *** 899,903 **** control is in use, and also (in case you care) which low-level system the file is actually stored in. Normally, such a source file is ! read-only, and the mode line indicates this with @samp{%%}. These are the commands for editing a file maintained with --- 899,905 ---- control is in use, and also (in case you care) which low-level system the file is actually stored in. Normally, such a source file is ! read-only, and the mode line indicates this with @samp{%%}. With RCS, ! the mode line also indicates the head version, which is normally also ! the version you are looking at. These are the commands for editing a file maintained with *************** *** 927,931 **** @kbd{C-x C-q} (@code{vc-toggle-read-only}). This @dfn{checks out} the file, and tells RCS or SCCS to lock the file. This means making the ! file writable for you (but not for anyone else). @cindex log entry --- 929,935 ---- @kbd{C-x C-q} (@code{vc-toggle-read-only}). This @dfn{checks out} the file, and tells RCS or SCCS to lock the file. This means making the ! file writable for you (but not for anyone else). The mode line ! indicates that you have locked the file by showing your name and ! a colon before the version number. @cindex log entry *************** *** 957,961 **** whether you want to ``steal the lock.'' If you say yes, the file becomes locked by you, but a message is sent to the person who had ! formerly locked the file, to inform him of what has happened. @kindex C-x v u --- 961,967 ---- whether you want to ``steal the lock.'' If you say yes, the file becomes locked by you, but a message is sent to the person who had ! formerly locked the file, to inform him of what has happened. The mode ! line indicates that a file is locked by someone else by displaying the ! login name of that person, before the version number. @kindex C-x v u diff -rc2P --exclude-from=exceptions emacs-19.16/man/frames.texi emacs-19.17/man/frames.texi *** emacs-19.16/man/frames.texi Tue Jun 1 02:52:22 1993 --- emacs-19.17/man/frames.texi Sun Jul 18 02:26:26 1993 *************** *** 52,57 **** Move point to where you release the mouse, and set the mark where you initially clicked the mouse (@code{mouse-set-region}). Thus, you can ! specify both ends of the region. @item mouse-2 Yank the last kill text, where you click (@code{mouse-yank-at-click}). --- 52,63 ---- Move point to where you release the mouse, and set the mark where you initially clicked the mouse (@code{mouse-set-region}). Thus, you can ! specify both ends of the region. In Transient Mark mode, the region ! highlighting appears and changes as you drag. + If you move the mouse off the top or bottom of the window while + dragging, the window scrolls at a steady rate until you move the mouse + back into the window. This way, you can mark regions that don't fit + entirely on the screen. + @item mouse-2 Yank the last kill text, where you click (@code{mouse-yank-at-click}). *************** *** 249,252 **** --- 255,264 ---- overlays. Any aspect of the display style that isn't specified by overlays or text properties comes from the frame itself. + + @findex list-faces-display + To see what faces are currently defined, and what they look like, type + @kbd{M-x list-faces-display}. It's possible for a given face to look + different in different frames; this command shows the appearance in the + frame in which you type it. @cindex @code{region} face diff -rc2P --exclude-from=exceptions emacs-19.16/man/gnus.texi emacs-19.17/man/gnus.texi *** emacs-19.16/man/gnus.texi Thu Jun 17 15:55:51 1993 --- emacs-19.17/man/gnus.texi Sat Jul 17 14:53:58 1993 *************** *** 8,11 **** --- 8,15 ---- @end iftex @setchapternewpage odd + @synindex fn cp + @synindex vr cp + @synindex ky cp + @synindex pg cp @c @smallbook @comment %**end of header (This is for running Texinfo on a region.) *************** *** 39,48 **** into another language, under the above conditions for modified versions. ! @node Reading News ! @section Introduction - @c ??? Make gnus-save-all-headers t by default, and don't mention it here - @c !!! Default value is changed in the source. - @cindex NNTP You can read netnews within Emacs using the GNUS package. GNUS uses the --- 43,49 ---- into another language, under the above conditions for modified versions. ! @node Top ! @top The GNUS News Reader @cindex NNTP You can read netnews within Emacs using the GNUS package. GNUS uses the *************** *** 57,62 **** recommend pronouncing it as ``gnoose'', to avoid confusion. ! @node Starting up, Buffers of GNUS, Introduction, Top ! @section Starting up GNUS @ifinfo --- 58,77 ---- recommend pronouncing it as ``gnoose'', to avoid confusion. ! @menu ! * Starting Up:: ! * Buffers of GNUS:: ! * Newsgroup Commands:: ! * Summary Commands:: ! * Article Commands:: ! * Startup File:: ! * Kill File:: ! * Troubleshooting:: ! * Customization:: ! * Reporting Bugs:: ! * Index:: ! @end menu ! ! @node Starting Up ! @chapter Starting GNUS @ifinfo *************** *** 67,76 **** @menu * Getting Started:: How to get started GNUS. ! * Local News Spool:: How to use a local news spool. ! * Private Directory:: How to read a private directory. @end menu @node Getting Started ! @subsection Getting Started GNUS @cindex invoke GNUS @cindex run GNUS --- 82,90 ---- @menu * Getting Started:: How to get started GNUS. ! * Finding the News:: Configuring how GNUS gets access to the news. @end menu @node Getting Started ! @section Getting Started GNUS @cindex invoke GNUS @cindex run GNUS *************** *** 90,95 **** @end table ! @node GNUS Server ! @subsection Telling GNUS Where To Find the News Somehow or other, GNUS has to know how to find the current netnews. --- 104,109 ---- @end table ! @node Finding the News ! @section Telling GNUS Where To Find the News Somehow or other, GNUS has to know how to find the current netnews. *************** *** 135,139 **** @node Buffers of GNUS ! @subsection Buffers Used by GNUS @cindex GNUS buffers @cindex buffers of GNUS --- 149,153 ---- @node Buffers of GNUS ! @chapter Buffers Used by GNUS @cindex GNUS buffers @cindex buffers of GNUS *************** *** 170,174 **** @node Newsgroup Buffer ! @subsection Newsgroup Buffer @cindex Newsgroup buffer @cindex Group mode --- 184,188 ---- @node Newsgroup Buffer ! @section Newsgroup Buffer @cindex Newsgroup buffer @cindex Group mode *************** *** 210,214 **** @node Summary Buffer ! @subsection Summary Buffer @cindex Summary buffer (GNUS) @cindex Summary mode (GNUS) --- 224,228 ---- @node Summary Buffer ! @section Summary Buffer @cindex Summary buffer (GNUS) @cindex Summary mode (GNUS) *************** *** 259,263 **** @node Newsgroup Commands ! @section Newsgroup Commands The Newsgroup buffer normally lists the newsgroups which you subscribe --- 273,277 ---- @node Newsgroup Commands ! @chapter Newsgroup Commands The Newsgroup buffer normally lists the newsgroups which you subscribe *************** *** 269,273 **** * Browsing Newsgroups:: Moving around in the Newsgroup buffer. * Selecting a Newsgroup:: Selecting a newsgroup to read articles. ! * Maintenance:: Maintaining newsgroups. * Exiting GNUS:: How to exit GNUS. * Other Newsgroup Commands:: Other miscellaneous commands. --- 283,287 ---- * Browsing Newsgroups:: Moving around in the Newsgroup buffer. * Selecting a Newsgroup:: Selecting a newsgroup to read articles. ! * Maintaining Subscriptions:: Subscribing and unsubscribing, etc. * Exiting GNUS:: How to exit GNUS. * Other Newsgroup Commands:: Other miscellaneous commands. *************** *** 275,279 **** @node Browsing Newsgroups ! @subsection Browsing Newsgroups Most of the newsgroup commands operate on the group described by the --- 289,293 ---- @node Browsing Newsgroups ! @section Browsing Newsgroups Most of the newsgroup commands operate on the group described by the *************** *** 349,353 **** @node Selecting a Newsgroup ! @subsection Selecting a Newsgroup @cindex select newsgroup @cindex read newsgroup --- 363,367 ---- @node Selecting a Newsgroup ! @section Selecting a Newsgroup @cindex select newsgroup @cindex read newsgroup *************** *** 415,420 **** @end ifset ! @node Maintaining Newsgroups ! @subsection Maintaining Newsgroups This section explains how to subscribe and unsubscribe, as well as other --- 429,434 ---- @end ifset ! @node Maintaining Subscriptions ! @section Maintaining Subscriptions This section explains how to subscribe and unsubscribe, as well as other *************** *** 439,444 **** @kindex l (Group Mode) @findex gnus-group-list-groups - @c ??? Is this completely true? - @c !!! Yes. Show only the newsgroups which you now subscribe to and which now contain unread and saved articles (@code{gnus-group-list-groups}). --- 453,456 ---- *************** *** 494,499 **** (@code{gnus-group-transpose-groups}).@refill - @c ??? This is a name change; now it's gnus-browse-killed-groups. - @c !!! Renamed in the source. @item M-x gnus-list-killed-groups @findex gnus-list-killed-groups --- 506,509 ---- *************** *** 543,550 **** and then use @kbd{u} on the groups you want to read.) You can also arrange to subscribe automatically to some or all newly created ! newsgroups using the options line in your startup file. ! @c ??? What is the name of the startup file? ! @c !!! Usually ~/.newsrc is used. ! @c @xref{Startup File}, for more information. @cindex kill newsgroups --- 553,558 ---- and then use @kbd{u} on the groups you want to read.) You can also arrange to subscribe automatically to some or all newly created ! newsgroups using the options line in your startup file, @file{~/.newsrc}. ! @xref{Startup File}, for more information. @cindex kill newsgroups *************** *** 583,588 **** articles available to be read. ! @node Exiting GNUS, Other Newsgroup Commands, Maintenance, Newsgroup Commands ! @subsection Exiting GNUS @table @kbd --- 591,596 ---- articles available to be read. ! @node Exiting GNUS ! @section Exiting GNUS @table @kbd *************** *** 633,643 **** the hook @code{gnus-suspend-gnus-hook} is called when suspending GNUS. - @c ??? Commented out because these commands kill the buffers themselves. - @c ??? Does anyone know what this was supposed to mean? - @c If you want to clear out Emacs buffers which were created by GNUS and - @c remain afterwards, use these hooks. - @node Other Newsgroup Commands,, Exiting GNUS, Newsgroup Commands ! @subsection Miscellaneous Commands Other miscellaneous Group mode commands are described here. --- 641,646 ---- the hook @code{gnus-suspend-gnus-hook} is called when suspending GNUS. @node Other Newsgroup Commands,, Exiting GNUS, Newsgroup Commands ! @section Miscellaneous Commands Other miscellaneous Group mode commands are described here. *************** *** 647,652 **** @kindex a (Group Mode) @findex gnus-group-post-news ! Compose a new article (@code{gnus-group-post-news}). @xref{Followup and ! Reply}, for more information. @item M-k --- 650,655 ---- @kindex a (Group Mode) @findex gnus-group-post-news ! Compose a new article (@code{gnus-group-post-news}). @xref{Posting ! Articles}, for more information. @item M-k *************** *** 687,692 **** @end table ! @node Summary Commands, Article Commands, Newsgroup Commands, Top ! @section Summary Commands The Summary buffer shows you a summary of the contents of a single --- 690,695 ---- @end table ! @node Summary Commands ! @chapter Summary Commands The Summary buffer shows you a summary of the contents of a single *************** *** 704,713 **** * Saving Articles:: Saving articles in your favorite format. * Sorting Headers:: Sorting the Summary buffer. ! * Followup and Reply:: Followup and reply commands. * Exiting Newsgroup:: How to exit the current newsgroup. @end menu ! @node Reading Articles, Searching Articles, Summary Commands, Summary Commands ! @subsection Reading Articles @kindex SPC (Summary Mode) --- 707,718 ---- * Saving Articles:: Saving articles in your favorite format. * Sorting Headers:: Sorting the Summary buffer. ! * Posting Articles:: How to post a new article or followup article. ! * Forward and Reply:: How to mail a reply to a message, ! or forward the message by mail. * Exiting Newsgroup:: How to exit the current newsgroup. @end menu ! @node Reading Articles ! @section Reading Articles @kindex SPC (Summary Mode) *************** *** 734,738 **** @node Summary Motion ! @subsubsection Cursor Motion in the Summary Buffer For moving around in the Summary buffer, you can use these special --- 739,743 ---- @node Summary Motion ! @subsection Cursor Motion in the Summary Buffer For moving around in the Summary buffer, you can use these special *************** *** 777,781 **** @node Reading an Article ! @subsubsection Commands to Read Articles @table @kbd --- 782,786 ---- @node Reading an Article ! @subsection Commands to Read Articles @table @kbd *************** *** 787,791 **** @c ??? This should be moved to another letter, but which? - @c !!! G is moved ot C-x C-s, instead. @item g @kindex g (Summary Mode) --- 792,795 ---- *************** *** 891,895 **** @node Scrolling ! @subsubsection Scrolling Within an Article This section describes the commands you can type in the Summary --- 895,899 ---- @node Scrolling ! @subsection Scrolling Within an Article This section describes the commands you can type in the Summary *************** *** 936,940 **** @node Moving Among Articles ! @subsubsection Moving Among Articles These commands move point in the Summary buffer to a different line --- 940,944 ---- @node Moving Among Articles ! @subsection Moving Among Articles These commands move point in the Summary buffer to a different line *************** *** 1000,1007 **** --- 1004,1013 ---- @findex gnus-summary-goto-last-article Read the article selected last (@code{gnus-summary-goto-last-article}). + @ignore If you repeat @kbd{l}, it keeps moving to articles that you read longer and longer ago. @c ??? That isn't implemented yet. @c !!! I hope in the next version. + @end ignore @c Equivalent to C-u j g. *************** *** 1057,1061 **** @node Marking Articles ! @subsubsection Marking Articles @cindex article status @cindex mark articles --- 1063,1067 ---- @node Marking Articles ! @subsection Marking Articles @cindex article status @cindex mark articles *************** *** 1184,1188 **** @node Thread-based Reading ! @subsubsection Reading Based on Conversation Threads @cindex threads (in GNUS) @cindex references between articles --- 1190,1194 ---- @node Thread-based Reading ! @subsection Reading Based on Conversation Threads @cindex threads (in GNUS) @cindex references between articles *************** *** 1295,1299 **** @node Digest Articles ! @subsubsection Reading Digest Articles @cindex digest articles --- 1301,1305 ---- @node Digest Articles ! @subsection Reading Digest Articles @cindex digest articles *************** *** 1341,1350 **** @vindex gnus-select-article-hook @cindex Rmail - @c ??? Fix the xref. The command @kbd{C-d} (@code{gnus-summary-rmail-digest}) runs Rmail on a digest article and makes it possible to read messages not in digest ! form using Rmail Mode. @xref{Rmail, Rmail, emacs}, for more ! information on Rmail Mode. Use the hook @code{gnus-select-article-hook} ! to run Rmail on digest articles automatically. @vindex gnus-select-digest-hook --- 1347,1356 ---- @vindex gnus-select-article-hook @cindex Rmail The command @kbd{C-d} (@code{gnus-summary-rmail-digest}) runs Rmail on a digest article and makes it possible to read messages not in digest ! form using Rmail Mode. @xref{Rmail,,, emacs, The GNU Emacs Manual}, for ! more information on Rmail Mode. Use the hook ! @code{gnus-select-article-hook} to run Rmail on digest articles ! automatically. @vindex gnus-select-digest-hook *************** *** 1365,1369 **** @node Searching Articles ! @subsection Searching Articles @cindex search for articles --- 1371,1375 ---- @node Searching Articles ! @section Searching Articles @cindex search for articles *************** *** 1422,1426 **** @node Referencing Articles ! @subsection Referencing Articles @cindex refer to articles --- 1428,1432 ---- @node Referencing Articles ! @section Referencing Articles @cindex refer to articles *************** *** 1455,1459 **** @node Saving Articles ! @subsection Saving Articles @cindex save articles --- 1461,1465 ---- @node Saving Articles ! @section Saving Articles @cindex save articles *************** *** 1490,1495 **** @vindex gnus-article-save-directory - @c ??? Is this right? - @c !!! Yes. @cindex @code{SAVEDIR} environment variable The variable @code{gnus-article-save-directory} specifies the default --- 1496,1499 ---- *************** *** 1516,1520 **** @node Sorting Headers ! @subsection Sorting Headers @cindex sort headers --- 1520,1524 ---- @node Sorting Headers ! @section Sorting Headers @cindex sort headers *************** *** 1559,1565 **** @node Posting Articles ! @subsection Posting Articles @cindex followup to article - @cindex reply to article @cindex cancel article @cindex post article --- 1563,1568 ---- @node Posting Articles ! @section Posting Articles @cindex followup to article @cindex cancel article @cindex post article *************** *** 1574,1579 **** @kindex f (Summary Mode) @findex gnus-summary-followup - @c ??? Name is to be changed; now gnus-summary-post-reply - @c !!! Renamed in the source. Compose a followup to the current article (@code{gnus-summary-followup}). --- 1577,1580 ---- *************** *** 1582,1587 **** @kindex F (Summary Mode) @findex gnus-summary-followup-with-original - @c ??? Name is to be changed; now gnus-summary-post-reply-with-original - @c !!! Renamed in the source. Compose a followup, and insert the original article right away (@code{gnus-summary-followup-with-original}). --- 1583,1586 ---- *************** *** 1643,1647 **** then type @kbd{C}. ! @node Replying with Mail @table @kbd --- 1642,1648 ---- then type @kbd{C}. ! @node Forward and Reply ! @section Forwarding Messages and Replying To Them ! @cindex reply to article @table @kbd *************** *** 1673,1679 **** @kindex R (Summary Mode) @findex gnus-summary-reply-with-original - @c ??? Names are to be changed; they are currently gnus-summary-mail-reply - @c ??? and gnus-summary-mail-reply-with-original - @c !!! Renamed in the source. Use the command @kbd{r} (@code{gnus-summary-reply}) to mail a reply to the author of the article. Type @kbd{C-c C-y} to yank the text of the --- 1674,1677 ---- *************** *** 1682,1686 **** automatically. ! @xref{Mail Mode}, for information on how to finish sending the reply. @ignore --- 1680,1685 ---- automatically. ! @xref{Mail Mode,,,emacs,The GNU Emacs Manual}, for information on how ! to finish sending the reply. @ignore *************** *** 1706,1710 **** @node Exiting Newsgroup ! @subsection Exiting the Current Newsgroup @dfn{Exiting} a newsgroup means going back to the Newsgroup buffer and --- 1705,1709 ---- @node Exiting Newsgroup ! @section Exiting the Current Newsgroup @dfn{Exiting} a newsgroup means going back to the Newsgroup buffer and *************** *** 1726,1731 **** status changes that took place while you were reading this newsgroup. - @c ??? This is a pending change. The command is now G. - @c !!! C-x C-s is used in the source. @item C-x C-s @kindex C-x C-s (Summary Mode) --- 1725,1728 ---- *************** *** 1747,1754 **** @end table - @c ??? Does this reread the active file? - @c ??? If so, it should be g. - @c ??? If not, it should be C-x C-s. - @c !!! C-x C-s in the source. @kindex C-x C-s (Summary Mode) @findex gnus-summary-reselect-current-group --- 1744,1747 ---- *************** *** 1761,1765 **** @ignore @node Other Summary Commands ! @subsection Miscellaneous Commands Other miscellaneous commands are described here. --- 1754,1758 ---- @ignore @node Other Summary Commands ! @section Miscellaneous Commands Other miscellaneous commands are described here. *************** *** 1803,1813 **** @cindex read Info file @cindex Info ! Read Info on Summary Mode (@code{gnus-info-find-node}). ! @xref{Texinfo Manual}, to prepare an Info file of GNUS. @end table @end ignore @node Article Commands ! @section Article Commands GNUS displays one article at a time, in a buffer called the Article --- 1796,1807 ---- @cindex read Info file @cindex Info ! Read Info on Summary Mode (@code{gnus-info-find-node}). @xref{Top, ! Texinfo, Texinfo, texinfo, The Texinfo Manual}, to prepare an Info file ! of GNUS. @end table @end ignore @node Article Commands ! @chapter Article Commands GNUS displays one article at a time, in a buffer called the Article *************** *** 1843,1851 **** message ID before using this command. ! @c ??? This is a change not yet made. ! @c ??? As of now, the character is o and the command name ! @c ??? is gnus-article-pop-article. ! @c !!! This is wrong. gnus-article-pop-article pops reference history, ! @c !!! and goes back along the history. @item o @kindex o (Article Mode) --- 1837,1841 ---- message ID before using this command. ! @c ??? This is unclear. I cannot tell what it means--rms. @item o @kindex o (Article Mode) *************** *** 1864,1869 **** @item h @kindex h (Article Mode) - @c ??? This name is yet to be changed; currently gnus-article-show-subject - @c !!! Renamed in the source. @findex gnus-article-show-summary Reconfigure Emacs windows to show the Summary buffer above the Article --- 1854,1857 ---- *************** *** 1886,1896 **** @cindex read Info file @cindex Info ! Read Info on Article Mode (@code{gnus-info-find-node}). ! @xref{Texinfo Manual}, to prepare an Info file of GNUS. @end ignore @end table @node Startup File ! @subsection The Startup File @cindex startup file @cindex quick startup file --- 1874,1885 ---- @cindex read Info file @cindex Info ! Read Info on Article Mode (@code{gnus-info-find-node}). @xref{Top, ! Texinfo, Texinfo, texinfo, The Texinfo Manual} to prepare an Info file ! of GNUS. @end ignore @end table @node Startup File ! @chapter The Startup File @cindex startup file @cindex quick startup file *************** *** 1932,1936 **** @node Kill File ! @section Kill File @cindex Kill file --- 1921,1925 ---- @node Kill File ! @chapter Kill File @cindex Kill file *************** *** 1955,1959 **** @node Making a Kill File ! @subsection Making a Kill File A kill file is simply a file of Lisp code that is loaded (i.e., --- 1944,1948 ---- @node Making a Kill File ! @section Making a Kill File A kill file is simply a file of Lisp code that is loaded (i.e., *************** *** 2033,2037 **** @node Editing Kill Files ! @subsection Editing Kill Files You can use these GNUS commands to find a kill file for editing: --- 2022,2026 ---- @node Editing Kill Files ! @section Editing Kill Files You can use these GNUS commands to find a kill file for editing: *************** *** 2101,2106 **** @cindex read Info file @cindex Info ! Read Info on kill file (@code{gnus-info-find-node}). ! @xref{Texinfo Manual}, to prepare an Info file of GNUS. @end ignore @end table --- 2090,2096 ---- @cindex read Info file @cindex Info ! Read Info on kill file (@code{gnus-info-find-node}). @xref{Top, ! Texinfo, Texinfo, texinfo, The Texinfo Manual}, to prepare an Info file ! of GNUS. @end ignore @end table *************** *** 2116,2121 **** author. ! @node Example of a Kill File ! @subsection Example of a Kill File This is a real example of a local kill file for newsgroup --- 2106,2111 ---- author. ! @node Kill File Example ! @section Example of a Kill File This is a real example of a local kill file for newsgroup *************** *** 2134,2138 **** @node Names of Kill Files ! @subsection Names of Kill Files @vindex gnus-article-save-directory --- 2124,2128 ---- @node Names of Kill Files ! @section Names of Kill Files @vindex gnus-article-save-directory *************** *** 2151,2155 **** @node Background Kills ! @subsection Background Kill Processing @cindex batch kill processing --- 2141,2145 ---- @node Background Kills ! @section Background Kill Processing @cindex batch kill processing *************** *** 2169,2173 **** @node Advanced Kills ! @subsection Advanced Kill Processing @findex gnus-apply-kill-file --- 2159,2163 ---- @node Advanced Kills ! @section Advanced Kill Processing @findex gnus-apply-kill-file *************** *** 2262,2267 **** initialized from the @code{NNTPSERVER} environment variable. If the server name is preceded by a colon such as @samp{:Mail}, the user's ! private directory @file{~/Mail} is used as a news spool. @xref{NNTP ! Server}, and @pxref{Private Directory}, for more information. @vindex gnus-nntp-service --- 2252,2257 ---- initialized from the @code{NNTPSERVER} environment variable. If the server name is preceded by a colon such as @samp{:Mail}, the user's ! private directory @file{~/Mail} is used as a news spool. @xref{Finding ! the News}, for more information. @vindex gnus-nntp-service *************** *** 2271,2276 **** few instances, it must be the number @code{119}. To use a local news spool of your machine rather than NNTP, set the variable to @code{nil}. ! @xref{NNTP Service}, and @pxref{Local News Spool}, for more ! information. @c !!! gnus-your-domain is renamed to gnus-local-domain. --- 2261,2265 ---- few instances, it must be the number @code{119}. To use a local news spool of your machine rather than NNTP, set the variable to @code{nil}. ! @xref{Finding the News}, for more information. @c !!! gnus-your-domain is renamed to gnus-local-domain. *************** *** 2284,2289 **** @code{DOMAINNAME} is used instead if defined. If the function @code{system-name} returns the full Internet name, there is no need to ! define the domain. @xref{Domain,, Domain and Organization}, for more information. @c !!! gnus-your-organization is renamed ot gnus-local-organization. --- 2273,2281 ---- @code{DOMAINNAME} is used instead if defined. If the function @code{system-name} returns the full Internet name, there is no need to ! define the domain. ! @ignore ! @xref{Domain,, Domain and Organization}, for more information. + @end ignore @c !!! gnus-your-organization is renamed ot gnus-local-organization. *************** *** 2295,2301 **** @code{ORGANIZATION} is used instead if defined. If the value begins with a slash, it is taken as the name of a file whose contents are read ! for the value. @xref{Domain,, Domain and Organization}, for more information. ! @cindex time zone @cindex Date field --- 2287,2296 ---- @code{ORGANIZATION} is used instead if defined. If the value begins with a slash, it is taken as the name of a file whose contents are read ! for the value. ! @ignore ! @xref{Domain,, Domain and Organization}, for more information. ! @end ignore ! @cindex time zone @cindex Date field *************** *** 2345,2349 **** string, it is used as your domain instead of the definition by the variable @code{gnus-local-domain} or the environment variable ! @code{DOMAINNAME}. @xref{GENERICFROM}, for more information. @vindex gnus-use-generic-path --- 2340,2347 ---- string, it is used as your domain instead of the definition by the variable @code{gnus-local-domain} or the environment variable ! @code{DOMAINNAME}. ! @ignore ! @xref{GENERICFROM}, for more information. ! @end ignore @vindex gnus-use-generic-path *************** *** 2354,2359 **** @samp{Path:} field of article headers. If the variable is a string, it is used in the @samp{Path:} field as the NNTP server name instead of the ! definition by the variable @code{gnus-nntp-server}. @xref{GENERICPATH}, for more information. @vindex gnus-ignored-newsgroups --- 2352,2360 ---- @samp{Path:} field of article headers. If the variable is a string, it is used in the @samp{Path:} field as the NNTP server name instead of the ! definition by the variable @code{gnus-nntp-server}. ! @ignore ! @xref{GENERICPATH}, for more information. + @end ignore @vindex gnus-ignored-newsgroups *************** *** 2867,2880 **** newsgroups. - @vindex gnus-info-directory - @cindex Info - @item gnus-info-directory - @vindex Info-directory - - Specifies a directory where the GNUS Info file is placed. It is not - necessary to change this variable unless you install an Info file in a - directory different from the variable @code{Info-directory}. - @xref{Texinfo Manual}, for more information. - @cindex MIME @pindex metamail --- 2868,2871 ---- *************** *** 3016,3020 **** newsgroup first, and then kills it. The killed newsgroups can be added to the subscription list interactively using Browse-Killed Mode ! (@pxref{Maintenance}). @findex gnus-subscribe-newsgroup --- 3007,3011 ---- newsgroup first, and then kills it. The killed newsgroups can be added to the subscription list interactively using Browse-Killed Mode ! (@pxref{Maintaining Subscriptions}). @findex gnus-subscribe-newsgroup *************** *** 3039,3044 **** Non-@code{nil} means the select routine of your operating system is buggy. GNUS may hang up while waiting for NNTP server responses. The ! problem may be solved by setting the variable to @code{t}. @xref{NNTP Problems}, for more information. @vindex nntp-maximum-request --- 3030,3038 ---- Non-@code{nil} means the select routine of your operating system is buggy. GNUS may hang up while waiting for NNTP server responses. The ! problem may be solved by setting the variable to @code{t}. ! @ignore ! @xref{NNTP Problems}, for more information. + @end ignore @vindex nntp-maximum-request *************** *** 3049,3053 **** newsgroup because sending many requests to the NNTP server without reading replies to them causes deadlock. In this case, set the variable ! to a lower number. @xref{NNTP Problems}, for more information. @vindex nntp-large-newsgroup --- 3043,3050 ---- newsgroup because sending many requests to the NNTP server without reading replies to them causes deadlock. In this case, set the variable ! to a lower number. ! @ignore ! @xref{NNTP Problems}, for more information. ! @end ignore @vindex nntp-large-newsgroup *************** *** 3074,3084 **** @pindex tcp.c @pindex tcp ! @pindex telnet ! Specifies a program which establishes communications between Emacs and ! the NNTP server. Its default value is @file{telnet}. Alternative is ! @file{tcp} which is distributed as @file{tcp.c} with other files of GNUS ! (@pxref{Files of GNUS}). If your Emacs has the function ! @code{open-network-stream}, there is no need to define this variable. ! @end table --- 3071,3080 ---- @pindex tcp.c @pindex tcp ! This variable specifies the name of the program which establishes ! communications between Emacs and the NNTP server. Its default value is ! @code{"tcp"}. (the program @code{tcp} comes with GNU Emacs.) This ! variable is relevant only if you load the library @file{tcp.el}, which ! you should do only if your Emacs does not have the function ! @code{open-network-stream}. @end table *************** *** 3506,3511 **** @end table ! @node Troubleshooting GNUS ! @section Troubleshooting GNUS @vindex nntp-buggy-select --- 3502,3507 ---- @end table ! @node Troubleshooting ! @chapter Troubleshooting GNUS @vindex nntp-buggy-select *************** *** 3605,3626 **** @inforef{Bugs, Reporting Bugs, emacs}, for more information. ! @node Key Index ! @unnumbered Key (Character) Index ! @printindex ky ! ! @node Command Index ! @unnumbered Command and Function Index ! @printindex fn ! ! @node Variable Index ! @unnumbered Variable Index ! @printindex vr ! ! @node Program Index ! @unnumbered Program Index ! @printindex pg ! ! @node Concept Index ! @unnumbered Concept Index @printindex cp --- 3601,3606 ---- @inforef{Bugs, Reporting Bugs, emacs}, for more information. ! @node Index ! @unnumbered Index @printindex cp diff -rc2P --exclude-from=exceptions emacs-19.16/man/help.texi emacs-19.17/man/help.texi *** emacs-19.16/man/help.texi Sun Jul 4 13:54:40 1993 --- emacs-19.17/man/help.texi Sun Jul 18 02:35:14 1993 *************** *** 342,345 **** --- 342,351 ---- syntax (@pxref{Syntax}). + You can get a similar list for a particular prefix key by typing + @kbd{C-h} after the prefix key. (There are a few prefix keys for which + this does not work---those that provide their own bindings for + @kbd{C-h}. One of these is @key{ESC}, because @kbd{@key{ESC} C-h} is + actually @kbd{C-M-h}, which marks a defun.) + @kindex C-h n @findex view-emacs-news diff -rc2P --exclude-from=exceptions emacs-19.16/man/programs.texi emacs-19.17/man/programs.texi *** emacs-19.16/man/programs.texi Thu Jun 17 18:03:21 1993 --- emacs-19.17/man/programs.texi Sun Jul 18 03:40:20 1993 *************** *** 716,719 **** --- 716,731 ---- is 12,000. + @cindex @code{paren} library + When using X Windows, you can request a more powerful kind of + automatic parenthesis matching by loading the @code{paren} library. + To load it, type @kbd{M-x load-library @key{RET} paren @key{RET}}. + This library turns off the usual kind of matching parenthesis display + and substitutes another: whenever point is after a close parenthesis, + the close parenthesis and its matching open parenthesis are both + highlighted; otherwise, if point is before an open parenthesis, the + matching close parenthesis is highlighted. (There is no need to + highlight the open parenthesis after point because the cursor appears on + top of that character.) + @node Comments @section Manipulating Comments *************** *** 1773,1780 **** in a C program.) ! @item M-x c-up-conditional @findex c-up-conditional ! In C mode, @code{c-up-conditional} moves back to the containing ! preprocessor conditional, setting the mark where point was previously. A prefix argument acts as a repeat count. With a negative argument, --- 1785,1793 ---- in a C program.) ! @item C-c C-u ! @kindex C-c C-u @r{(C mode)} @findex c-up-conditional ! Move back to the containing preprocessor conditional, setting the mark ! at the starting point (@code{c-up-conditional}). A prefix argument acts as a repeat count. With a negative argument, *************** *** 1782,1785 **** --- 1795,1810 ---- conditional. When going backwards, @samp{#elif} acts like @samp{#else} followed by @samp{#if}. When going forwards, @samp{#elif} is ignored. + + @item C-c C-n + @kindex C-c C-n @r{(C mode)} + @findex c-forward-conditional + Move forward across the next preprocessor conditional, setting the mark + at the starting point (@code{c-forward-conditional}). + + @item C-c C-p + @kindex C-c C-p @r{(C mode)} + @findex c-backward-conditional + Move backward across the previous preprocessor conditional, setting the + at the starting point (@code{c-backward-conditional}). @item M-x c-macro-expand diff -rc2P --exclude-from=exceptions emacs-19.16/man/rmail.texi emacs-19.17/man/rmail.texi *** emacs-19.16/man/rmail.texi Fri Jun 11 11:56:57 1993 --- emacs-19.17/man/rmail.texi Sun Jul 18 02:23:32 1993 *************** *** 404,411 **** The @kbd{C-o} (@code{rmail-output}) command in Rmail appends a copy of ! the current message to a specified file, in Unix mail file format. This is useful for moving messages into files to be read by other mail processors that do not understand Rmail format. @vindex rmail-delete-after-output Copying a message with @kbd{o} or @kbd{C-o} gives the original copy of --- 404,416 ---- The @kbd{C-o} (@code{rmail-output}) command in Rmail appends a copy of ! the current message to a specified file, in inbox file format. This is useful for moving messages into files to be read by other mail processors that do not understand Rmail format. + The @kbd{o} and @kbd{C-o} commands are actually equivalent when + you specify an existing file; both commands check the file's contents + to determine which format to use (Rmail or inbox). Which command + you use makes a difference when you specify a nonexistent file. + @vindex rmail-delete-after-output Copying a message with @kbd{o} or @kbd{C-o} gives the original copy of *************** *** 433,457 **** name. - Normally you should use only @kbd{o} to output messages to other Rmail - files, never @kbd{C-o}. But it is also safe if you always use @kbd{C-o}, - never @kbd{o}. When a file is visited in Rmail, the last message is - checked, and if it is in Unix format, the entire file is scanned and all - Unix-format messages are converted to Rmail format. (The reason for - checking the last message is that scanning the file is slow and most Rmail - files have only Rmail format messages.) If you use @kbd{C-o} consistently, - the last message is sure to be in Unix format, so Rmail will convert all - messages properly. - - The case where you might want to use @kbd{C-o} always, instead of @kbd{o} - always, is when you or other users want to append mail to the same file - from other mail processors. Other mail processors probably do not know - Rmail format but do know Unix format. - - In any case, always use @kbd{o} to add to an Rmail file that is being - visited in Rmail. Adding messages with @kbd{C-o} to the actual disk - file will trigger a ``simultaneous editing'' warning when you ask to - save the Emacs buffer. The messages you added to the file will then be - lost if you do save the buffer. - @node Rmail Labels @section Labels --- 438,441 ---- *************** *** 653,656 **** --- 637,647 ---- @samp{*mail*} buffer, to finish editing an outgoing message you were already composing, or to alter a message you have sent.@refill + + @vindex rmail-mail-new-frame + If you set the variable @code{rmail-mail-new-frame} to a + non-@code{nil} value, then all the Rmail commands to start sending a + message create a new frame to edit it in. This frame is deleted when + you send the message, or when you use the @samp{Don't Send} item in the + @samp{Mail} menu. @node Rmail Summary diff -rc2P --exclude-from=exceptions emacs-19.16/man/search.texi emacs-19.17/man/search.texi *** emacs-19.16/man/search.texi Thu Jun 17 16:12:10 1993 --- emacs-19.17/man/search.texi Sun Jul 18 02:27:21 1993 *************** *** 777,781 **** @kbd{C-x @key{ESC} @key{RET}} to restart (@pxref{Repetition}). ! @item @key{ESC} to exit without doing any more replacements. --- 777,782 ---- @kbd{C-x @key{ESC} @key{RET}} to restart (@pxref{Repetition}). ! @item @key{RET} ! @itemx @key{ESC} to exit without doing any more replacements. diff -rc2P --exclude-from=exceptions emacs-19.16/man/split-man emacs-19.17/man/split-man *** emacs-19.16/man/split-man Sun Jun 27 17:10:56 1993 --- emacs-19.17/man/split-man Sat Jul 10 16:16:01 1993 *************** *** 12,22 **** dviselect -i emacs.dvi -o emacs221.dvi 221-240 dviselect -i emacs.dvi -o emacs241.dvi 241-260 ! dviselect -i emacs.dvi -o emacs241.dvi 261-280 ! dviselect -i emacs.dvi -o emacs241.dvi 281-300 ! dviselect -i emacs.dvi -o emacs241.dvi 301-320 ! dviselect -i emacs.dvi -o emacs241.dvi 321-340 ! dviselect -i emacs.dvi -o emacs241.dvi 341-360 ! dviselect -i emacs.dvi -o emacs241.dvi 361-380 ! dviselect -i emacs.dvi -o emacs241.dvi 381-400 ! dviselect -i emacs.dvi -o emacs241.dvi 401- dviselect -i emacs.dvi -o emacs0.dvi _20-0 --- 12,22 ---- dviselect -i emacs.dvi -o emacs221.dvi 221-240 dviselect -i emacs.dvi -o emacs241.dvi 241-260 ! dviselect -i emacs.dvi -o emacs261.dvi 261-280 ! dviselect -i emacs.dvi -o emacs281.dvi 281-300 ! dviselect -i emacs.dvi -o emacs301.dvi 301-320 ! dviselect -i emacs.dvi -o emacs321.dvi 321-340 ! dviselect -i emacs.dvi -o emacs341.dvi 341-360 ! dviselect -i emacs.dvi -o emacs361.dvi 361-380 ! dviselect -i emacs.dvi -o emacs381.dvi 381-400 ! dviselect -i emacs.dvi -o emacs401.dvi 401- dviselect -i emacs.dvi -o emacs0.dvi _20-0 diff -rc2P --exclude-from=exceptions emacs-19.16/man/trouble.texi emacs-19.17/man/trouble.texi *** emacs-19.16/man/trouble.texi Thu Jun 17 16:27:08 1993 --- emacs-19.17/man/trouble.texi Sun Jul 18 00:26:46 1993 *************** *** 162,166 **** end of the buffer, check for the word @samp{Narrow} in the mode line. If it appears, the text is still present, but temporarily off-limits. ! To make it accessible again, type @kbd{C-x w}. @xref{Narrowing}. @node Unasked-for Search --- 162,166 ---- end of the buffer, check for the word @samp{Narrow} in the mode line. If it appears, the text is still present, but temporarily off-limits. ! To make it accessible again, type @kbd{C-x n w}. @xref{Narrowing}. @node Unasked-for Search diff -rc2P --exclude-from=exceptions emacs-19.16/oldXMenu/ChangeLog emacs-19.17/oldXMenu/ChangeLog *** emacs-19.16/oldXMenu/ChangeLog Tue Jul 6 11:08:02 1993 --- emacs-19.17/oldXMenu/ChangeLog Mon Jul 19 02:02:22 1993 *************** *** 1,2 **** --- 1,13 ---- + Mon Jul 19 02:02:12 1993 Richard Stallman (rms@sugar-bombs.gnu.ai.mit.edu) + + * Version 19.17 released. + + Wed Jul 7 03:13:22 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * Makefile.in: Write out the dependencies for the object files; + otherwise, VPATH won't work. + + * Makefile.in: Re-arrange, to put `all' target at the top. + Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) diff -rc2P --exclude-from=exceptions emacs-19.16/oldXMenu/Makefile.in emacs-19.17/oldXMenu/Makefile.in *** emacs-19.16/oldXMenu/Makefile.in Fri Jun 18 20:05:16 1993 --- emacs-19.17/oldXMenu/Makefile.in Wed Jul 7 03:30:44 1993 *************** *** 25,57 **** tags TAGS make.log - SRCS = ${srcdir}/Activate.c \ - ${srcdir}/AddPane.c \ - ${srcdir}/AddSel.c \ - ${srcdir}/ChgPane.c \ - ${srcdir}/ChgSel.c \ - ${srcdir}/Create.c \ - ${srcdir}/DelPane.c \ - ${srcdir}/DelSel.c \ - ${srcdir}/Destroy.c \ - ${srcdir}/Error.c \ - ${srcdir}/EvHand.c \ - ${srcdir}/FindPane.c \ - ${srcdir}/FindSel.c \ - ${srcdir}/InsPane.c \ - ${srcdir}/InsSel.c \ - ${srcdir}/Internal.c \ - ${srcdir}/Locate.c \ - ${srcdir}/Post.c \ - ${srcdir}/Recomp.c \ - ${srcdir}/SetAEQ.c \ - ${srcdir}/SetFrz.c \ - ${srcdir}/SetPane.c \ - ${srcdir}/SetSel.c \ - ${srcdir}/XDelAssoc.c \ - ${srcdir}/XLookAssoc.c \ - ${srcdir}/XCrAssoc.c \ - ${srcdir}/XDestAssoc.c \ - ${srcdir}/XMakeAssoc.c - OBJS = Activate.o \ AddPane.o \ --- 25,28 ---- *************** *** 79,82 **** --- 50,55 ---- XDelAssoc.o XLookAssoc.o XCrAssoc.o XDestAssoc.o XMakeAssoc.o + all:: libXMenu11.a + ALL_CFLAGS=$(C_SWITCH_SITE) $(C_SWITCH_SYSTEM) $(C_SWITCH_X_SITE) \ $(C_SWITCH_MACHINE) $(CPPFLAGS) $(CFLAGS) -DEMACS_BITMAP_FILES *************** *** 85,90 **** $(CC) -c ${ALL_CFLAGS} $< - all:: libXMenu11.a - libXMenu11.a: $(OBJS) $(EXTRA) $(RM) $@ --- 58,61 ---- *************** *** 93,96 **** --- 64,97 ---- #If running ranlib fails, probably there is none. #That's ok. So don't stop the build. + + Activate.o: Activate.c XMenuInt.h XMenu.h X10.h + AddPane.o: AddPane.c XMenuInt.h XMenu.h X10.h + AddSel.o: AddSel.c XMenuInt.h XMenu.h X10.h + ChgPane.o: ChgPane.c XMenuInt.h XMenu.h X10.h + ChgSel.o: ChgSel.c XMenuInt.h XMenu.h X10.h + Create.o: Create.c XMenuInt.h XMenu.h X10.h + DelPane.o: DelPane.c XMenuInt.h XMenu.h X10.h + DelSel.o: DelSel.c XMenuInt.h XMenu.h X10.h + Destroy.o: Destroy.c XMenuInt.h XMenu.h X10.h + Error.o: Error.c XMenuInt.h XMenu.h X10.h + EvHand.o: EvHand.c XMenuInt.h XMenu.h X10.h + FindPane.o: FindPane.c XMenuInt.h XMenu.h X10.h + FindSel.o: FindSel.c XMenuInt.h XMenu.h X10.h + InsPane.o: InsPane.c XMenuInt.h XMenu.h X10.h + InsSel.o: InsSel.c XMenuInt.h XMenu.h X10.h + Internal.o: Internal.c XMenuInt.h XMenu.h X10.h + Locate.o: Locate.c XMenuInt.h XMenu.h X10.h + Post.o: Post.c XMenuInt.h XMenu.h X10.h + Recomp.o: Recomp.c XMenuInt.h XMenu.h X10.h + SetAEQ.o: SetAEQ.c XMenuInt.h XMenu.h X10.h + SetFrz.o: SetFrz.c XMenuInt.h XMenu.h X10.h + SetPane.o: SetPane.c XMenuInt.h XMenu.h X10.h + SetSel.o: SetSel.c XMenuInt.h XMenu.h X10.h + XDelAssoc.o: XDelAssoc.c X10.h + XLookAssoc.o: XLookAssoc.c X10.h + XCrAssoc.o: XCrAssoc.c X10.h + XDestAssoc.o: XDestAssoc.c X10.h + XMakeAssoc.o: XMakeAssoc.c X10.h + insque.o: insque.c FRC.mostlyclean: diff -rc2P --exclude-from=exceptions emacs-19.16/src/.gdbinit emacs-19.17/src/.gdbinit *** emacs-19.16/src/.gdbinit Fri Jul 2 18:51:20 1993 --- emacs-19.17/src/.gdbinit Wed Jul 7 03:57:47 1993 *************** *** 147,150 **** --- 147,157 ---- end + define xfloat + print ((struct Lisp_Float *) (($ & 0x00ffffff) | $data_seg_bits))->data + end + document xfloat + Print $ assuming it is a lisp floating-point number. + end + define xscrollbar print (struct scrollbar *) (($ & 0x00ffffff) | $data_seg_bits) diff -rc2P --exclude-from=exceptions emacs-19.16/src/ChangeLog emacs-19.17/src/ChangeLog *** emacs-19.16/src/ChangeLog Tue Jul 6 12:28:41 1993 --- emacs-19.17/src/ChangeLog Mon Jul 19 01:58:52 1993 *************** *** 1,2 **** --- 1,298 ---- + Sun Jul 18 00:17:28 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * Version 19.17 released. + + * xfns.c (Fx_create_frame): Block input around call to + x_new_font. Test if the return value is a string, not if it's + nil; x_new_font can return things besides nil and strings, to + indicate error conditions. + + * window.c [not MULTI_FRAME] (Fdelete_windows_on): Set FRAME + argument to Qt, instead of trying to typecheck it. + + * ymakefile (config_h): Set this to ${srcdir}/config.h; all the + source dependencies mention $(config_h), but until now it never + had a value. + + * xfns.c (Fx_open_connection): Don't trust HAVE_XRMSETDATABASE; + use XrmSetDatabase only when HAVE_X11R5 is defined. + + * dispnew.c (direct_output_for_insert): By the time this function + is called, we have already inserted the character into the buffer; + the proper buffer position to pass to compute_char_face is point + - 1, not point. + + Sat Jul 17 02:45:04 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * Makefile.in (C_SWITCH_SYSTEM): New variable, set by top-level + Makefile. + (xmakefile): Pass it to the C preprocessor. + + * window.c (Fdelete_windows_on): New optional argument FRAME; if + nil, delete windows on all frames. If t, delete windows on the + selected frame only. If a frame, delete windows on that frame + only. + + * intervals.c (split_interval_left, split_interval_right): Change + OFFSET argument of these functions to be origin 0, not origin 1. + This is what all the callers currently want. + * intervals.c, textprop.c: All callers changed. + + * textprop.c (Ftext_property_not_all): Renamed from + Ftext_property_all, and changed sense of return value, so that it + returns useful information if not all characters have properties + EQ to value. Now all the existential and universal questions can + be asked. + + * textprop.c (syms_of_textprop): Don't forget defsubr for + Stext_property_all. + + * textprop.c (Ftext_property_any, Ftext_property_all): Use EQ to + compare property values, not Fequal. + + * xterm.c (x_term_init): Adjust message printed when we can't + connect to the X server. + + * xfns.c (Vx_resource_name): Renamed from Vxrdb_name, and made a + lisp-visible variable, so lisp/term/x-win.el can set it. Doc it + for "internal use only"; no need for NEWS entry. + (validate_x_resource_name): New function. + (Fx_get_resource): Doc fix. References to Vxrdb_name renamed. Call + validate_x_resource_name. + (x_window): References to Vxrdb_name renamed. Call + validate_x_resource_name. + (Fx_open_connection): References to Vxrdb_name renamed. Instead + of setting and validating its value here, just call + validate_x_resource_name. + (syms_of_xfns): Add DEFVAR_LISP for Vx_resource_name. + + Fri Jul 16 21:43:32 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * keyboard.c (Vhelp_menu_bar_map): Deleted. + (menu_bar_items): Move elts for events in Vmenu_bar_final_items to end. + (syms_of_keyboard): Corresponding changes. + + Thu Jul 15 20:52:15 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + Consistently use the mark bit of the root interval's parent field + to say whether or not the interval tree has been visited (and skip + it when revisited), and the mark bit of the plist field to say + whether or not that interval has been visited (and abort if + revisited); don't try to use the plist mark bit for both + meanings. + * alloc.c (mark_interval_tree): Don't test if the interval tree + has already been visited here; let the MARK_INTERVAL_TREE macro do + that; avoid function call overhead. Mark the interval tree as + having been visited by setting TREE->parent's mark bit. + (MARK_INTERVAL_TREE): If the tree has been visited (according to + I->parent's mark bit), don't call mark_interval_tree. + (gc_sweep): Rebalance the interval trees of those large strings + which are still alive. This also clears the mark bits of those + trees' root intervals' parent fields. + (compact_strings): Rebalance the interval tree of each small + strings which is still alive. This also clears the mark bits of + that tree's root interval's parent field. Since the string has + moved, update the root interval's parent pointer to contain the + new address. + * lisp.h (struct interval): Doc fix; explain the roles of the mark + bits of the parent and plist members. + + * termhooks.h: In order to avoid declaring struct input_event + (which contains Lisp_Objects) in those .c files which need access + to the terminal hooks but don't #include lisp.h (like cm.c), test + to see if the macro CONSP is #defined. We used to test XINT, but + config.h will #define that everywhere on systems that use tailored + tagging schemes. + + * window.c (Fnext_window, Fprevious_window): Put these docstrings + in comments; the strings are too long for some C compilers. + + * s/hpux9.h: Doc fix. + + Thu Jul 15 19:05:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * ymakefile (DEBUG_MOLE): New variable; a shell expression which + expands to -DDEBUG_MOLE on HP 9000/300's in the domain + gnu.ai.mit.edu, and the empty string on all other machines. + (alloc.o): Cite ${DEBUG_MOLE}, so DEBUG_MOLE is #defined when + compiling on mole. + + Thu Jul 15 02:01:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * keyboard.c (read_char_menu_prompt): If the user rejects a menu, + return t. This makes read_char also return t. + (read_key_sequence): If read_char returned t, return -1. + (Fread_key_sequence): If read_key_sequence returned -1, quit. + (command_loop_1): If read_key_sequence returned -1, loop around. + + Thu Jul 15 00:56:31 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * keyboard.c (menu_bar_one_keymap): If the key's binding is the + symbol `undefined', don't try to take that symbol's cdr before + passing it to menu_bar_item; pass the `undefined' binding itself, + so menu_bar_item can remove bindings for the same key from result. + + Wed Jul 14 12:02:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * buffer.c (Fbuffer_local_variables): For local var that is unbound, + put just the symbol in the result, not a cons of (symbol . value). + + * keyboard.c (Qdisabled_command_hook): New variable. + (Vdisabled_command_hook): Deleted. + (syms_of_keyboard): Corresponding changes. + (Fcommand_execute): Use Qdisabled_command_hook. + + * alloc.c (mark_object) [DEBUG_MOLE]: Add abort at beginning. + + * keyboard.c (Vhelp_menu_bar_map): New var. + (syms_of_keyboard): Set up Lisp var for it. + (menu_bar_items): Use Vhelp_menu_bar_map. + + Wed Jul 14 00:14:31 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * textprop.c (Ftext_property_any, Ftext_property_all): New + functions, from David Gillespie. + * intervals.h (Ftext_property_any, Ftext_property_all): Declare them. + + * keyboard.c (read_key_sequence): Accept both strings and vectors + as bindings in function-key-map. + * keymap.c (Vfunction_key_map in syms_of_keymap): Doc fix. + + * keyboard.c (Fsuspend_emacs): Pass selected_frame as the first + argument to change_frame_size, not 0. This function may be called + in an Emacs compiled with multi-frame support. + + Tue Jul 13 17:25:32 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * xterm.c (XTread_socket, UnmapNotify case): Add missing comment + terminator. + + * intervals.c (graft_intervals_into_buffer): Properly compute + length of buffer. + + Tue Jul 13 17:03:09 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * minibuf.c (Fdisplay_completion_list): Run completion-setup-hook. + + Mon Jul 12 18:46:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * textprop.c (Qinsert_in_front_hooks, Qinsert_behind_hooks): New vars. + (syms_of_textprop): Set them up. + * lisp.h (Qinsert_in_front_hooks, Qinsert_behind_hooks): Declared. + (Qmodification_hooks): Declared. + + * intervals.c (verify_interval_modification): + For insertion, run the insert-in-front-hooks and insert-behind-hooks, + not the modification-hooks. + * buffer.c (verify_overlay_modification): New function. + (call_overlay_mod_hooks): New function. + * insdel.c (prepare_to_modify_buffer): Call that. + + * keyboard.c (Qundefined): New variable. + (syms_of_keyboard): Set up Qundefined. + (menu_bar_items): Don't reverse the items. + Process the maps in reverse order. + (menu_bar_item): If definition is `undefined', + delete any menu bar item already made, and don't make one. + + Mon Jul 12 16:41:12 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * print.c (float_to_string): Distinguish between a precision of + zero and an omitted precision. Do allow %.0f to produce strings + containing no decimal point or exponent. + (syms_of_print): Doc fix for float-output-format. + + * xfns.c (x_set_frame_parameters): Don't set the frame's size and + position unless those parameters are actually specified in ALIST. + + * syntax.c (Fmodify_syntax_entry): Doc fix. + + Mon Jul 12 14:43:38 1993 Frederic Pierresteguy (F.Pierresteguy@frcl.bull.fr) + + * xterm.c, sysdep.c (F_SETOWN_BUG): Defined. + * m/dpx2.h: New file. + + Sat Jul 10 19:23:41 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * textprop.c (set_properties): Call modify_region. + (remove_properties): Call modify_region before record_property_change. + (add_properties): Likewise. + + Sat Jul 10 18:49:26 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * xrdb.c: Implement search for app-defaults directory and + localized default databases, along with some other functionality + provided by Xt. + #include , since we call sprintf. + [emacs] (malloc, realloc, free): #define these to xmalloc, + xrealloc, and xfree. + (x_get_string_resource, file_p): Add forward declarations for + these. + (x_customization_string): New variable. + (x_get_customization_string): New function. + (gethomedir): Return malloc'ed space of the right size, instead of + writing into a fixed-size buffer; this means that our callers do + not impose an arbitrary limit on file name length. + (magic_file_p): Rewrite of decode_magic; actually do the + substitutions, instead of expanding all %-escapes to "". Support + the customization string. Return 0 or the expanded file name, + instead of just zero or one. Allocate the space for the expanded + file name ourselves, instead of writing into a fixed-size buffer + passed to us; this removes an arbitrary limit. + (search_magic_path): Rewrite of magic_searchpath_decoder. Return + 0 or the expanded file name, instead of just zero or one. + Allocate the space for the expanded file name ourselves, instead + of writing into a fixed-size buffer passed to us; this means that + our callers do not impose an arbitrary limit on file name length. + (get_system_app): Changed to work with search_magic_path. + (get_user_app): Rewritten to work with search_magic_path, and not + to assume that the values of XAPPLRESDIR is a single directory. + (get_user_db): Properly use the new version of gethomedir. + (get_environ_db): Remove arbitrary limit on length of host name. + (x_load_resources): Take a new argument, myname. Call get_user_db + early to obtain the customization string. + Changes to stand-alone testing code. + * xfns.c (Fx_open_connection): Set Vxrdb_name early, and pass it + to x_load_resources. + + * keymap.c (syms_of_keymap): Doc fix. + + Fri Jul 9 17:41:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * process.c (wait_reading_process_input): If wait_for_cell, do call + swallow_events and do_pending_window_change when appropriate. + + Thu Jul 8 19:45:22 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * editfns.c (region_limit): Declare Vmark_even_if_inactive. + + * callint.c (syms_of_callint): + Fix DEFVAR_LISP for Vmark_even_if_inactive to use right + Lisp symbol name (without V prepended). + + Thu Jul 8 17:43:11 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * callint.c (check_mark): Don't check mark-active unless in + transient-mark-mode. + For inactive mark, signal mark-inactive instead of error with a + message. + * editfns.c (region_limit): Don't error if Vmark_even_if_inactive + is set. + When the mark is inactive and that is a no-no, signal + mark-inactive instead of using error with a message. + * data.c (syms_of_data): Staticpro Qmark_inactive. + * data.c: Define Qmark_inactive. + (syms_of_data): Initialize it. + * lisp.h: Declare Qmark_inactive. + + Wed Jul 7 03:58:15 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * editfns.c (Fformat): Since floats occupy two elements in the + argument list passed to doprnt, we must use separate indices for + the array of arguments passed to Fformat, and the array of + arguments to be passed to doprnt. + + * .gdbinit (xfloat): New command. + Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) diff -rc2P --exclude-from=exceptions emacs-19.16/src/Makefile.in emacs-19.17/src/Makefile.in *** emacs-19.16/src/Makefile.in Fri Jun 18 18:24:21 1993 --- emacs-19.17/src/Makefile.in Sun Jul 18 02:06:54 1993 *************** *** 11,14 **** --- 11,15 ---- CPP=cc -E CFLAGS=-g + C_SWITCH_SYSTEM= srcdir=@srcdir@/src VPATH=@srcdir@/src *************** *** 80,84 **** -rm -f xmakefile xmakefile.new junk.c junk.cpp cp ${srcdir}/ymakefile junk.c ! ${CPP} -I${srcdir} ${CFLAGS} junk.c > junk.cpp < junk.cpp \ sed -e 's/^#.*//' \ --- 81,85 ---- -rm -f xmakefile xmakefile.new junk.c junk.cpp cp ${srcdir}/ymakefile junk.c ! ${CPP} -I${srcdir} ${CFLAGS} ${C_SWITCH_SYSTEM} junk.c > junk.cpp < junk.cpp \ sed -e 's/^#.*//' \ diff -rc2P --exclude-from=exceptions emacs-19.16/src/alloc.c emacs-19.17/src/alloc.c *** emacs-19.16/src/alloc.c Tue Jun 29 17:07:47 1993 --- emacs-19.17/src/alloc.c Sun Jul 18 02:07:00 1993 *************** *** 350,361 **** register INTERVAL tree; { ! if (XMARKBIT (tree->plist)) ! return; traverse_intervals (tree, 1, 0, mark_interval, Qnil); } ! #define MARK_INTERVAL_TREE(i) \ ! { if (!NULL_INTERVAL_P (i)) mark_interval_tree (i); } /* The oddity in the call to XUNMARK is necessary because XUNMARK --- 350,370 ---- register INTERVAL tree; { ! /* No need to test if this tree has been marked already; this ! function is always called through the MARK_INTERVAL_TREE macro, ! which takes care of that. */ ! ! /* XMARK expands to an assignment; the LHS of an assignment can't be ! a cast. */ ! XMARK (* (Lisp_Object *) &tree->parent); traverse_intervals (tree, 1, 0, mark_interval, Qnil); } ! #define MARK_INTERVAL_TREE(i) \ ! do { \ ! if (!NULL_INTERVAL_P (i) \ ! && ! XMARKBIT ((Lisp_Object) i->parent)) \ ! mark_interval_tree (i); \ ! } while (0) /* The oddity in the call to XUNMARK is necessary because XUNMARK *************** *** 1461,1464 **** --- 1470,1478 ---- register Lisp_Object obj; + #ifdef DEBUG_MOLE + if (*(int *) ((char *)__builtin_frame_address (0) - 16) == 0) + abort (); + #endif + obj = *objptr; XUNMARK (obj); *************** *** 1953,1975 **** { register struct string_block *sb = large_string_blocks, *prev = 0, *next; while (sb) ! if (!(((struct Lisp_String *)(&sb->chars[0]))->size & ARRAY_MARK_FLAG)) ! { ! if (prev) ! prev->next = sb->next; ! else ! large_string_blocks = sb->next; ! next = sb->next; ! xfree (sb); ! sb = next; ! } ! else ! { ! ((struct Lisp_String *)(&sb->chars[0]))->size ! &= ~ARRAY_MARK_FLAG & ~MARKBIT; ! total_string_size += ((struct Lisp_String *)(&sb->chars[0]))->size; ! prev = sb, sb = sb->next; ! } } } --- 1967,1994 ---- { register struct string_block *sb = large_string_blocks, *prev = 0, *next; + struct Lisp_String *s; while (sb) ! { ! s = (struct Lisp_String *) &sb->chars[0]; ! if (s->size & ARRAY_MARK_FLAG) ! { ! ((struct Lisp_String *)(&sb->chars[0]))->size ! &= ~ARRAY_MARK_FLAG & ~MARKBIT; ! UNMARK_BALANCE_INTERVALS (s->intervals); ! total_string_size += ((struct Lisp_String *)(&sb->chars[0]))->size; ! prev = sb, sb = sb->next; ! } ! else ! { ! if (prev) ! prev->next = sb->next; ! else ! large_string_blocks = sb->next; ! next = sb->next; ! xfree (sb); ! sb = next; ! } ! } } } *************** *** 2063,2066 **** --- 2082,2095 ---- /* Store the actual size in the size field. */ newaddr->size = size; + + /* Now that the string has been relocated, rebalance its + interval tree, and update the tree's parent pointer. */ + if (! NULL_INTERVAL_P (newaddr->intervals)) + { + UNMARK_BALANCE_INTERVALS (newaddr->intervals); + XSET (* (Lisp_Object *) &newaddr->intervals->parent, + Lisp_String, + newaddr); + } } pos += STRING_FULLSIZE (size); diff -rc2P --exclude-from=exceptions emacs-19.16/src/alloca.c emacs-19.17/src/alloca.c *** emacs-19.16/src/alloca.c Tue Jul 6 12:38:48 1993 --- emacs-19.17/src/alloca.c Sun Jul 18 04:33:20 1993 *************** *** 46,50 **** provide an "address metric" ADDRESS_FUNCTION macro. */ ! #ifdef CRAY long i00afunc (); #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) --- 46,50 ---- provide an "address metric" ADDRESS_FUNCTION macro. */ ! #if defined (CRAY) && defined (CRAY_STACKSEG_END) long i00afunc (); #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) *************** *** 205,209 **** } ! #ifdef CRAY #ifdef DEBUG_I00AFUNC --- 205,209 ---- } ! #if defined (CRAY) && defined (CRAY_STACKSEG_END) #ifdef DEBUG_I00AFUNC diff -rc2P --exclude-from=exceptions emacs-19.16/src/buffer.c emacs-19.17/src/buffer.c *** emacs-19.16/src/buffer.c Tue Jun 22 03:37:04 1993 --- emacs-19.17/src/buffer.c Thu Jul 15 00:42:02 1993 *************** *** 101,104 **** --- 101,105 ---- Lisp_Object Fset_buffer (); void set_buffer_internal (); + static void call_overlay_mod_hooks (); /* Alist of all buffer names vs the buffers. */ *************** *** 400,404 **** Sbuffer_local_variables, 0, 1, 0, "Return an alist of variables that are buffer-local in BUFFER.\n\ ! Each element looks like (SYMBOL . VALUE) and describes one variable.\n\ Note that storing new VALUEs in these elements doesn't change the variables.\n\ No argument or nil as argument means use current buffer as BUFFER.") --- 401,406 ---- Sbuffer_local_variables, 0, 1, 0, "Return an alist of variables that are buffer-local in BUFFER.\n\ ! Most elements look like (SYMBOL . VALUE), describing one variable.\n\ ! For a symbol that is locally unbound, just the symbol appears in the value.\n\ Note that storing new VALUEs in these elements doesn't change the variables.\n\ No argument or nil as argument means use current buffer as BUFFER.") *************** *** 407,411 **** { register struct buffer *buf; ! register Lisp_Object val; if (NILP (buffer)) --- 409,413 ---- { register struct buffer *buf; ! register Lisp_Object result; if (NILP (buffer)) *************** *** 417,420 **** --- 419,424 ---- } + result = Qnil; + { /* Reference each variable in the alist in our current buffer. *************** *** 423,438 **** If inquiring about some other buffer, this swaps out any values for that buffer, making the alist up to date automatically. */ ! register Lisp_Object tem; ! for (tem = buf->local_var_alist; CONSP (tem); tem = XCONS (tem)->cdr) { ! Lisp_Object v1 = Fsymbol_value (XCONS (XCONS (tem)->car)->car); if (buf == current_buffer) ! XCONS (XCONS (tem)->car)->cdr = v1; } } - /* Make a copy of the alist, to return it. */ - val = Fcopy_alist (buf->local_var_alist); - /* Add on all the variables stored in special slots. */ { --- 427,451 ---- If inquiring about some other buffer, this swaps out any values for that buffer, making the alist up to date automatically. */ ! register Lisp_Object tail; ! for (tail = buf->local_var_alist; CONSP (tail); tail = XCONS (tail)->cdr) { ! Lisp_Object val, elt; ! ! elt = XCONS (tail)->car; ! if (buf == current_buffer) ! val = find_symbol_value (XCONS (elt)->car); ! else ! val = XCONS (elt)->cdr; ! ! /* If symbol is unbound, put just the symbol in the list. */ ! if (EQ (val, Qunbound)) ! result = Fcons (XCONS (elt)->car, result); ! /* Otherwise, put (symbol . value) in the list. */ ! else ! result = Fcons (Fcons (XCONS (elt)->car, val), result); } } /* Add on all the variables stored in special slots. */ { *************** *** 447,456 **** if (XTYPE (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols)) == Lisp_Symbol) ! val = Fcons (Fcons (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols), ! *(Lisp_Object *)(offset + (char *)buf)), ! val); } } ! return (val); } --- 460,470 ---- if (XTYPE (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols)) == Lisp_Symbol) ! result = Fcons (Fcons (*(Lisp_Object *)(offset + (char *)&buffer_local_symbols), ! *(Lisp_Object *)(offset + (char *)buf)), ! result); } } ! ! return result; } *************** *** 1867,1870 **** --- 1881,1978 ---- return value; + } + + /* Run the modification-hooks of overlays that include + any part of the text in START to END. + Run the insert-before-hooks of overlay starting at END, + and the insert-after-hooks of overlay ending at START. */ + + void + verify_overlay_modification (start, end) + Lisp_Object start, end; + { + Lisp_Object prop, overlay, tail; + int insertion = EQ (start, end); + + for (tail = current_buffer->overlays_before; + CONSP (tail); + tail = XCONS (tail)->cdr) + { + int startpos, endpos; + int ostart, oend; + + overlay = XCONS (tail)->car; + + ostart = OVERLAY_START (overlay); + oend = OVERLAY_END (overlay); + endpos = OVERLAY_POSITION (oend); + if (XFASTINT (start) > endpos) + break; + startpos = OVERLAY_POSITION (ostart); + if (XFASTINT (end) == startpos && insertion) + { + prop = Foverlay_get (overlay, Qinsert_in_front_hooks); + call_overlay_mod_hooks (prop, overlay, start, end); + } + if (XFASTINT (start) == endpos && insertion) + { + prop = Foverlay_get (overlay, Qinsert_behind_hooks); + call_overlay_mod_hooks (prop, overlay, start, end); + } + if (insertion + ? (XFASTINT (start) > startpos && XFASTINT (end) < endpos) + : (XFASTINT (start) >= startpos && XFASTINT (end) <= endpos)) + { + prop = Foverlay_get (overlay, Qmodification_hooks); + call_overlay_mod_hooks (prop, overlay, start, end); + } + } + + for (tail = current_buffer->overlays_after; + CONSP (tail); + tail = XCONS (tail)->cdr) + { + int startpos, endpos; + int ostart, oend; + + overlay = XCONS (tail)->car; + + ostart = OVERLAY_START (overlay); + oend = OVERLAY_END (overlay); + startpos = OVERLAY_POSITION (ostart); + if (XFASTINT (end) < startpos) + break; + if (XFASTINT (end) == startpos && insertion) + { + prop = Foverlay_get (overlay, Qinsert_in_front_hooks); + call_overlay_mod_hooks (prop, overlay, start, end); + } + if (XFASTINT (start) == endpos && insertion) + { + prop = Foverlay_get (overlay, Qinsert_behind_hooks); + call_overlay_mod_hooks (prop, overlay, start, end); + } + if (insertion + ? (XFASTINT (start) > startpos && XFASTINT (end) < endpos) + : (XFASTINT (start) >= startpos && XFASTINT (end) <= endpos)) + { + prop = Foverlay_get (overlay, Qmodification_hooks); + call_overlay_mod_hooks (prop, overlay, start, end); + } + } + } + + static void + call_overlay_mod_hooks (list, overlay, start, end) + Lisp_Object list, overlay, start, end; + { + struct gcpro gcpro1; + GCPRO1 (list); + while (!NILP (list)) + { + call3 (Fcar (list), overlay, start, end); + list = Fcdr (list); + } + UNGCPRO; } diff -rc2P --exclude-from=exceptions emacs-19.16/src/callint.c emacs-19.17/src/callint.c *** emacs-19.16/src/callint.c Thu Jul 1 19:56:57 1993 --- emacs-19.17/src/callint.c Thu Jul 8 19:43:28 1993 *************** *** 146,151 **** if (NILP (tem) || (XBUFFER (tem) != current_buffer)) error ("The mark is not set now"); ! if (NILP (current_buffer->mark_active) && NILP (Vmark_even_if_inactive)) ! error ("The mark is not active now"); } --- 146,152 ---- if (NILP (tem) || (XBUFFER (tem) != current_buffer)) error ("The mark is not set now"); ! if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) ! && NILP (current_buffer->mark_active)) ! Fsignal (Qmark_inactive, Qnil); } *************** *** 662,666 **** Vcommand_debug_status = Qnil; ! DEFVAR_LISP ("Vmark-even-if-inactive", &Vmark_even_if_inactive, "*Non-nil means you can use the mark even when inactive.\n\ This option makes a difference in Transient Mark mode.\n\ --- 663,667 ---- Vcommand_debug_status = Qnil; ! DEFVAR_LISP ("mark-even-if-inactive", &Vmark_even_if_inactive, "*Non-nil means you can use the mark even when inactive.\n\ This option makes a difference in Transient Mark mode.\n\ diff -rc2P --exclude-from=exceptions emacs-19.16/src/data.c emacs-19.17/src/data.c *** emacs-19.16/src/data.c Sat Jun 12 03:20:26 1993 --- emacs-19.17/src/data.c Thu Jul 8 17:27:25 1993 *************** *** 44,48 **** Lisp_Object Qsetting_constant, Qinvalid_read_syntax; Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; ! Lisp_Object Qend_of_file, Qarith_error; Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qlistp, Qconsp; --- 44,48 ---- Lisp_Object Qsetting_constant, Qinvalid_read_syntax; Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; ! Lisp_Object Qend_of_file, Qarith_error, Qmark_inactive; Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qlistp, Qconsp; *************** *** 1944,1947 **** --- 1944,1948 ---- Qend_of_buffer = intern ("end-of-buffer"); Qbuffer_read_only = intern ("buffer-read-only"); + Qmark_inactive = intern ("mark-inactive"); Qlistp = intern ("listp"); *************** *** 2126,2129 **** --- 2127,2131 ---- staticpro (&Qend_of_buffer); staticpro (&Qbuffer_read_only); + staticpro (&Qmark_inactive); staticpro (&Qlistp); diff -rc2P --exclude-from=exceptions emacs-19.16/src/dispnew.c emacs-19.17/src/dispnew.c *** emacs-19.16/src/dispnew.c Wed Jun 9 07:30:25 1993 --- emacs-19.17/src/dispnew.c Sun Jul 18 02:07:08 1993 *************** *** 880,884 **** #ifdef HAVE_X_WINDOWS int dummy; ! int face = compute_char_face (frame, w, point, -1, -1, &dummy); #else int face = 0; --- 880,884 ---- #ifdef HAVE_X_WINDOWS int dummy; ! int face = compute_char_face (frame, w, point - 1, -1, -1, &dummy); #else int face = 0; diff -rc2P --exclude-from=exceptions emacs-19.16/src/editfns.c emacs-19.17/src/editfns.c *** emacs-19.16/src/editfns.c Wed Jun 16 18:37:16 1993 --- emacs-19.17/src/editfns.c Thu Jul 8 19:45:09 1993 *************** *** 198,204 **** int beginningp; { register Lisp_Object m; ! if (!NILP (Vtransient_mark_mode) && NILP (current_buffer->mark_active)) ! error ("There is no region now"); m = Fmarker_position (current_buffer->mark); if (NILP (m)) error ("There is no region now"); --- 198,206 ---- int beginningp; { + extern Lisp_Object Vmark_even_if_inactive; /* Defined in callint.c. */ register Lisp_Object m; ! if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) ! && NILP (current_buffer->mark_active)) ! Fsignal (Qmark_inactive, Qnil); m = Fmarker_position (current_buffer->mark); if (NILP (m)) error ("There is no region now"); *************** *** 1395,1409 **** { register int nstrings = n + 1; register unsigned char **strings ! = (unsigned char **) alloca (nstrings * sizeof (unsigned char *)); for (n = 0; n < nstrings; n++) { if (n >= nargs) ! strings[n] = (unsigned char *) ""; else if (XTYPE (args[n]) == Lisp_Int) /* We checked above that the corresponding format effector isn't %s, which would cause MPV. */ ! strings[n] = (unsigned char *) XINT (args[n]); #ifdef LISP_FLOAT_TYPE else if (XTYPE (args[n]) == Lisp_Float) --- 1397,1416 ---- { register int nstrings = n + 1; + + /* Allocate twice as many strings as we have %-escapes; floats occupy + two slots, and we're not sure how many of those we have. */ register unsigned char **strings ! = (unsigned char **) alloca (2 * nstrings * sizeof (unsigned char *)); ! int i; + i = 0; for (n = 0; n < nstrings; n++) { if (n >= nargs) ! strings[i++] = (unsigned char *) ""; else if (XTYPE (args[n]) == Lisp_Int) /* We checked above that the corresponding format effector isn't %s, which would cause MPV. */ ! strings[i++] = (unsigned char *) XINT (args[n]); #ifdef LISP_FLOAT_TYPE else if (XTYPE (args[n]) == Lisp_Float) *************** *** 1412,1421 **** u.d = XFLOAT (args[n])->data; ! strings[n++] = (unsigned char *) u.half[0]; ! strings[n] = (unsigned char *) u.half[1]; } #endif else ! strings[n] = XSTRING (args[n])->data; } --- 1419,1428 ---- u.d = XFLOAT (args[n])->data; ! strings[i++] = (unsigned char *) u.half[0]; ! strings[i++] = (unsigned char *) u.half[1]; } #endif else ! strings[i++] = XSTRING (args[n])->data; } *************** *** 1426,1430 **** buf[total - 1] = 0; ! length = doprnt (buf, total + 1, strings[0], end, nargs, strings + 1); if (buf[total - 1] == 0) break; --- 1433,1437 ---- buf[total - 1] = 0; ! length = doprnt (buf, total + 1, strings[0], end, i-1, strings + 1); if (buf[total - 1] == 0) break; diff -rc2P --exclude-from=exceptions emacs-19.16/src/getloadavg.c emacs-19.17/src/getloadavg.c *** emacs-19.16/src/getloadavg.c Wed Jun 9 16:28:35 1993 --- emacs-19.17/src/getloadavg.c Mon Jul 12 18:13:12 1993 *************** *** 437,441 **** /* Put the 1 minute, 5 minute and 15 minute load averages into the first NELEM elements of LOADAVG. ! Return the number written (never more than 3), or -1 if an error occurred. */ --- 437,441 ---- /* Put the 1 minute, 5 minute and 15 minute load averages into the first NELEM elements of LOADAVG. ! Return the number written (never more than 3, but may be less than NELEM), or -1 if an error occurred. */ *************** *** 495,504 **** unsigned info_count; ! if (nelem > 1) ! { ! /* We only know how to get the 1-minute average for this system. */ ! errno = EINVAL; ! return -1; ! } if (!getloadavg_initialized) --- 495,500 ---- unsigned info_count; ! /* We only know how to get the 1-minute average for this system, ! so even if the caller asks for more than 1, we only return 1. */ if (!getloadavg_initialized) *************** *** 700,704 **** if (offset == 0) { - #ifndef SUNOS_5 #ifndef sgi #ifndef NLIST_STRUCT --- 696,699 ---- *************** *** 715,718 **** --- 710,714 ---- #endif /* NLIST_STRUCT */ + #ifndef SUNOS_5 if (nlist (KERNEL_FILE, nl) >= 0) /* Omit "&& nl[0].n_type != 0 " -- it breaks on Sun386i. */ *************** *** 723,726 **** --- 719,723 ---- offset = nl[0].n_value; } + #endif /* !SUNOS_5 */ #else /* sgi */ int ldav_off; *************** *** 730,734 **** offset = (long) ldav_off & 0x7fffffff; #endif /* sgi */ - #endif /* !SUNOS_5 */ } --- 727,730 ---- *************** *** 741,748 **** --- 737,748 ---- getloadavg_initialized = 1; #else /* SUNOS_5 */ + /* We pass 0 for the kernel, corefile, and swapfile names + to use the currently running kernel. */ kd = kvm_open (0, 0, 0, O_RDONLY, 0); if (kd != 0) { + /* nlist the currently running kernel. */ kvm_nlist (kd, nl); + offset = nl[0].n_value; getloadavg_initialized = 1; } diff -rc2P --exclude-from=exceptions emacs-19.16/src/insdel.c emacs-19.17/src/insdel.c *** emacs-19.16/src/insdel.c Wed Jun 9 07:30:59 1993 --- emacs-19.17/src/insdel.c Tue Jul 13 17:06:01 1993 *************** *** 514,517 **** --- 514,519 ---- verify_interval_modification (current_buffer, start, end); + verify_overlay_modification (start, end); + #ifdef CLASH_DETECTION if (!NILP (current_buffer->filename) diff -rc2P --exclude-from=exceptions emacs-19.16/src/intervals.c emacs-19.17/src/intervals.c *** emacs-19.16/src/intervals.c Tue Jul 6 09:53:07 1993 --- emacs-19.17/src/intervals.c Sun Jul 18 02:07:13 1993 *************** *** 63,67 **** if (XTYPE (parent) == Lisp_Buffer) { ! new->total_length = BUF_Z (XBUFFER (parent)) - 1; XBUFFER (parent)->intervals = new; } --- 63,68 ---- if (XTYPE (parent) == Lisp_Buffer) { ! new->total_length = (BUF_Z (XBUFFER (parent)) ! - BUF_BEG (XBUFFER (parent))); XBUFFER (parent)->intervals = new; } *************** *** 348,354 **** } ! /* Split INTERVAL into two pieces, starting the second piece at character ! position OFFSET (counting from 1), relative to INTERVAL. The right-hand ! piece (second, lexicographically) is returned. The size and position fields of the two intervals are set based upon --- 349,356 ---- } ! /* Split INTERVAL into two pieces, starting the second piece at ! character position OFFSET (counting from 0), relative to INTERVAL. ! INTERVAL becomes the left-hand piece, and the right-hand piece ! (second, lexicographically) is returned. The size and position fields of the two intervals are set based upon *************** *** 367,373 **** INTERVAL new = make_interval (); int position = interval->position; ! int new_length = LENGTH (interval) - offset + 1; ! new->position = position + offset - 1; new->parent = interval; --- 369,375 ---- INTERVAL new = make_interval (); int position = interval->position; ! int new_length = LENGTH (interval) - offset; ! new->position = position + offset; new->parent = interval; *************** *** 390,396 **** } ! /* Split INTERVAL into two pieces, starting the second piece at character ! position OFFSET (counting from 1), relative to INTERVAL. The left-hand ! piece (first, lexicographically) is returned. The size and position fields of the two intervals are set based upon --- 392,399 ---- } ! /* Split INTERVAL into two pieces, starting the second piece at ! character position OFFSET (counting from 0), relative to INTERVAL. ! INTERVAL becomes the right-hand piece, and the left-hand piece ! (first, lexicographically) is returned. The size and position fields of the two intervals are set based upon *************** *** 409,416 **** INTERVAL new = make_interval (); int position = interval->position; ! int new_length = offset - 1; new->position = interval->position; ! interval->position = interval->position + offset - 1; new->parent = interval; --- 412,419 ---- INTERVAL new = make_interval (); int position = interval->position; ! int new_length = offset; new->position = interval->position; ! interval->position = interval->position + offset; new->parent = interval; *************** *** 1041,1045 **** { /* New right node. */ ! split_interval_right (slot, length + 1); return slot; } --- 1044,1048 ---- { /* New right node. */ ! split_interval_right (slot, length); return slot; } *************** *** 1048,1058 **** { /* New left node. */ ! split_interval_left (slot, LENGTH (slot) - length + 1); return slot; } /* Convert interval SLOT into three intervals. */ ! split_interval_left (slot, start - slot->position + 1); ! split_interval_right (slot, length + 1); return slot; } --- 1051,1061 ---- { /* New left node. */ ! split_interval_left (slot, LENGTH (slot) - length); return slot; } /* Convert interval SLOT into three intervals. */ ! split_interval_left (slot, start - slot->position); ! split_interval_right (slot, length); return slot; } *************** *** 1061,1068 **** /* Insert the intervals of SOURCE into BUFFER at POSITION. ! This is used in insdel.c when inserting Lisp_Strings into ! the buffer. The text corresponding to SOURCE is already in ! the buffer when this is called. The intervals of new tree are ! those belonging to the string being inserted; a copy is not made. If the inserted text had no intervals associated, this function --- 1064,1072 ---- /* Insert the intervals of SOURCE into BUFFER at POSITION. ! This is used in insdel.c when inserting Lisp_Strings into the ! buffer. The text corresponding to SOURCE is already in the buffer ! when this is called. The intervals of new tree are a copy of those ! belonging to the string being inserted; intervals are never ! shared. If the inserted text had no intervals associated, this function *************** *** 1109,1113 **** /* The inserted text constitutes the whole buffer, so simply copy over the interval structure. */ ! if (BUF_Z (buffer) == TOTAL_LENGTH (source)) { buffer->intervals = reproduce_tree (source, tree->parent); --- 1113,1117 ---- /* The inserted text constitutes the whole buffer, so simply copy over the interval structure. */ ! if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source)) { buffer->intervals = reproduce_tree (source, tree->parent); *************** *** 1155,1159 **** { INTERVAL end_unchanged ! = split_interval_left (this, position - under->position + 1); copy_properties (under, end_unchanged); under->position = position; --- 1159,1163 ---- { INTERVAL end_unchanged ! = split_interval_left (this, position - under->position); copy_properties (under, end_unchanged); under->position = position; *************** *** 1174,1180 **** while (! NULL_INTERVAL_P (over)) { ! position = LENGTH (over) + 1; ! if (position < LENGTH (under)) ! this = split_interval_left (under, position); else this = under; --- 1178,1183 ---- while (! NULL_INTERVAL_P (over)) { ! if (LENGTH (over) + 1 < LENGTH (under)) ! this = split_interval_left (under, LENGTH (over)); else this = under; *************** *** 1474,1482 **** } ! /* Run both mod hooks (just once if they're the same). */ if (!NULL_INTERVAL_P (prev)) ! prev_mod_hooks = textget (prev->plist, Qmodification_hooks); if (!NULL_INTERVAL_P (i)) ! mod_hooks = textget (i->plist, Qmodification_hooks); GCPRO1 (mod_hooks); if (! NILP (prev_mod_hooks)) --- 1477,1485 ---- } ! /* Run both insert hooks (just once if they're the same). */ if (!NULL_INTERVAL_P (prev)) ! prev_mod_hooks = textget (prev->plist, Qinsert_behind_hooks); if (!NULL_INTERVAL_P (i)) ! mod_hooks = textget (i->plist, Qinsert_in_front_hooks); GCPRO1 (mod_hooks); if (! NILP (prev_mod_hooks)) *************** *** 1620,1624 **** { i = next_interval (i); ! t = split_interval_right (t, prevlen + 1); copy_properties (i, t); prevlen = LENGTH (i); --- 1623,1627 ---- { i = next_interval (i); ! t = split_interval_right (t, prevlen); copy_properties (i, t); prevlen = LENGTH (i); diff -rc2P --exclude-from=exceptions emacs-19.16/src/intervals.h emacs-19.17/src/intervals.h *** emacs-19.16/src/intervals.h Tue Jul 6 05:25:32 1993 --- emacs-19.17/src/intervals.h Sun Jul 18 02:07:17 1993 *************** *** 202,205 **** --- 202,206 ---- extern Lisp_Object Fadd_text_properties (), Fset_text_properties (); extern Lisp_Object Fremove_text_properties (), Ferase_text_properties (); + extern Lisp_Object Ftext_property_any (), Ftext_property_all (); extern Lisp_Object copy_text_properties (); diff -rc2P --exclude-from=exceptions emacs-19.16/src/keyboard.c emacs-19.17/src/keyboard.c *** emacs-19.16/src/keyboard.c Mon Jul 5 03:45:07 1993 --- emacs-19.17/src/keyboard.c Sun Jul 18 02:07:31 1993 *************** *** 85,89 **** /* Non-nil disable property on a command means do not execute it; call disabled-command-hook's value instead. */ ! Lisp_Object Qdisabled, Vdisabled_command_hook; #define NUM_RECENT_KEYS (100) --- 85,89 ---- /* Non-nil disable property on a command means do not execute it; call disabled-command-hook's value instead. */ ! Lisp_Object Qdisabled, Qdisabled_command_hook; #define NUM_RECENT_KEYS (100) *************** *** 131,134 **** --- 131,137 ---- Lisp_Object Vprefix_help_command; + /* List of items that should move to the end of the menu bar. */ + Lisp_Object Vmenu_bar_final_items; + /* Character that causes a quit. Normally C-g. *************** *** 243,246 **** --- 246,250 ---- Lisp_Object Qforward_char; Lisp_Object Qbackward_char; + Lisp_Object Qundefined; /* read_key_sequence stores here the command definition of the *************** *** 987,990 **** --- 991,1002 ---- if (i == 0) /* End of file -- happens only in */ return Qnil; /* a kbd macro, at the end. */ + /* -1 means read_key_sequence got a menu that was rejected. + Just loop around and read another command. */ + if (i == -1) + { + cancel_echoing (); + this_command_key_count = 0; + continue; + } last_command_char = keybuf[i - 1]; *************** *** 1293,1297 **** If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1 if we used a mouse menu to read the input, or zero otherwise. If ! USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone. */ Lisp_Object --- 1305,1311 ---- If USED_MOUSE_MENU is non-zero, then we set *USED_MOUSE_MENU to 1 if we used a mouse menu to read the input, or zero otherwise. If ! USED_MOUSE_MENU is zero, *USED_MOUSE_MENU is left alone. ! ! Value is t if we showed a menu and the user rejected it. */ Lisp_Object *************** *** 3148,3152 **** Lisp_Object *maps; ! Lisp_Object def, tem; Lisp_Object result; --- 3162,3166 ---- Lisp_Object *maps; ! Lisp_Object def, tem, tail; Lisp_Object result; *************** *** 3187,3191 **** result = Qnil; ! for (mapno = 0; mapno < nmaps; mapno++) { if (! NILP (maps[mapno])) --- 3201,3205 ---- result = Qnil; ! for (mapno = nmaps - 1; mapno >= 0; mapno--) { if (! NILP (maps[mapno])) *************** *** 3199,3202 **** --- 3213,3225 ---- } + for (tail = Vmenu_bar_final_items; CONSP (tail); tail = XCONS (tail)->cdr) + { + Lisp_Object elt; + + elt = Fassq (XCONS (tail)->car, result); + if (!NILP (elt)) + result = Fcons (elt, Fdelq (elt, result)); + } + result = Fnreverse (result); Vinhibit_quit = oquit; *************** *** 3228,3231 **** --- 3251,3257 ---- Fcdr (binding), result); } + else if (EQ (binding, Qundefined)) + result = menu_bar_item (key, item_string, + binding, result); } else if (XTYPE (item) == Lisp_Vector) *************** *** 3246,3249 **** --- 3272,3278 ---- Fcdr (binding), result); } + else if (EQ (binding, Qundefined)) + result = menu_bar_item (key, item_string, + binding, result); } } *************** *** 3257,3263 **** Lisp_Object key, item_string, def, result; { ! Lisp_Object tem, elt; Lisp_Object enabled; /* See if this entry is enabled. */ enabled = Qt; --- 3286,3300 ---- Lisp_Object key, item_string, def, result; { ! Lisp_Object tem; Lisp_Object enabled; + if (EQ (def, Qundefined)) + { + /* If a map has an explicit nil as definition, + discard any previously made menu bar item. */ + tem = Fassq (key, result); + return Fdelq (tem, result); + } + /* See if this entry is enabled. */ enabled = Qt; *************** *** 3274,3279 **** /* Add an entry for this key and string if there is none yet. */ ! elt = Fassq (key, result); ! if (!NILP (enabled) && NILP (elt)) result = Fcons (Fcons (key, Fcons (item_string, Qnil)), result); --- 3311,3316 ---- /* Add an entry for this key and string if there is none yet. */ ! tem = Fassq (key, result); ! if (!NILP (enabled) && NILP (tem)) result = Fcons (Fcons (key, Fcons (item_string, Qnil)), result); *************** *** 3284,3291 **** static int echo_now; ! /* Read a character like read_char but optionally prompt based on maps ! in the array MAPS. NMAPS is the length of MAPS. Return nil if we ! decided not to read a character, because there are no menu items in ! MAPS. PREV_EVENT is the previous input event, or nil if we are reading --- 3321,3327 ---- static int echo_now; ! /* Read a character using menus based on maps in the array MAPS. ! NMAPS is the length of MAPS. Return nil if there are no menus in the maps. ! Return t if we displayed a menu but the user rejected it. PREV_EVENT is the previous input event, or nil if we are reading *************** *** 3362,3366 **** } if (NILP (value)) ! XSET (value, Lisp_Int, quit_char); if (used_mouse_menu) *used_mouse_menu = 1; --- 3398,3402 ---- } if (NILP (value)) ! value = Qt; if (used_mouse_menu) *used_mouse_menu = 1; *************** *** 3593,3596 **** --- 3629,3633 ---- Prompt with PROMPT. Return the length of the key sequence stored. + Return -1 if the user rejected a command menu. Echo starting immediately unless `prompt' is 0. *************** *** 3831,3834 **** --- 3868,3876 ---- &used_mouse_menu); + /* read_char returns t when it shows a menu and the user rejects it. + Just return -1. */ + if (EQ (key, Qt)) + return -1; + /* read_char returns -1 at the end of a macro. Emacs 18 handles this by returning immediately with a *************** *** 4127,4140 **** sequence (i.e. fkey_end == t), replace it with the binding and restart with fkey_start at the end. */ ! if (XTYPE (fkey_next) == Lisp_Vector && fkey_end == t) { ! t = fkey_start + XVECTOR (fkey_next)->size; if (t >= bufsize) error ("key sequence too long"); ! bcopy (XVECTOR (fkey_next)->contents, ! keybuf + fkey_start, ! (t - fkey_start) * sizeof (keybuf[0])); mock_input = t; --- 4169,4193 ---- sequence (i.e. fkey_end == t), replace it with the binding and restart with fkey_start at the end. */ ! if ((VECTORP (fkey_next) || STRINGP (fkey_next)) && fkey_end == t) { ! int len = Flength (fkey_next); ! ! t = fkey_start + len; if (t >= bufsize) error ("key sequence too long"); ! if (VECTORP (fkey_next)) ! bcopy (XVECTOR (fkey_next)->contents, ! keybuf + fkey_start, ! (t - fkey_start) * sizeof (keybuf[0])); ! else if (STRINGP (fkey_next)) ! { ! int i; ! ! for (i = 0; i < len; i++) ! XFASTINT (keybuf[fkey_start + i]) = ! XSTRING (fkey_next)->data[i]; ! } mock_input = t; *************** *** 4238,4241 **** --- 4291,4299 ---- NILP (prompt) ? 0 : XSTRING (prompt)->data); + if (i == -1) + { + Vquit_flag = Qt; + QUIT; + } UNGCPRO; return make_event_array (i, keybuf); *************** *** 4265,4269 **** tem = Fget (cmd, Qdisabled); if (!NILP (tem)) ! return call1 (Vrun_hooks, Vdisabled_command_hook); } --- 4323,4327 ---- tem = Fget (cmd, Qdisabled); if (!NILP (tem)) ! return call1 (Vrun_hooks, Qdisabled_command_hook); } *************** *** 4539,4543 **** get_frame_size (&width, &height); if (width != old_width || height != old_height) ! change_frame_size (0, height, width, 0, 0); /* Run suspend-resume-hook. */ --- 4597,4601 ---- get_frame_size (&width, &height); if (width != old_width || height != old_height) ! change_frame_size (selected_frame, height, width, 0, 0); /* Run suspend-resume-hook. */ *************** *** 4899,4902 **** --- 4957,4963 ---- syms_of_keyboard () { + Qdisabled_command_hook = intern ("disabled-command-hook"); + staticpro (&Qdisabled_command_hook); + Qself_insert_command = intern ("self-insert-command"); staticpro (&Qself_insert_command); *************** *** 4911,4914 **** --- 4972,4978 ---- staticpro (&Qdisabled); + Qundefined = intern ("undefined"); + staticpro (&Qundefined); + Qpre_command_hook = intern ("pre-command-hook"); staticpro (&Qpre_command_hook); *************** *** 5020,5027 **** defsubr (&Sexecute_extended_command); - DEFVAR_LISP ("disabled-command-hook", &Vdisabled_command_hook, - "Value is called instead of any command that is disabled\n\ - \(has a non-nil `disabled' property)."); - DEFVAR_LISP ("last-command-char", &last_command_char, "Last input event that was part of a command."); --- 5084,5087 ---- *************** *** 5181,5184 **** --- 5241,5249 ---- "t means menu bar, specified Lucid style, needs to be recomputed."); Vlucid_menu_bar_dirty_flag = Qnil; + + DEFVAR_LISP ("menu-bar-final-items", &Vmenu_bar_final_items, + "List of menu bar items to move to the end of the menu bar.\n\ + The elements of the listare event types that may have menu bar bindings."); + Vmenu_bar_final_items = Qnil; } diff -rc2P --exclude-from=exceptions emacs-19.16/src/keymap.c emacs-19.17/src/keymap.c *** emacs-19.16/src/keymap.c Sun Jul 4 15:04:01 1993 --- emacs-19.17/src/keymap.c Sun Jul 18 02:07:39 1993 *************** *** 2244,2255 **** function-key-map with their bindings. When the current local and global\n\ keymaps have no binding for the current key sequence but\n\ ! function-key-map binds a suffix of the sequence to a vector,\n\ read-key-sequence replaces the matching suffix with its binding, and\n\ continues with the new sequence.\n\ \n\ ! For example, suppose function-key-map binds `ESC O P' to [pf1].\n\ ! Typing `ESC O P' to read-key-sequence would return [pf1]. Typing\n\ ! `C-x ESC O P' would return [?\C-x pf1]. If [pf1] were a prefix\n\ ! key, typing `ESC O P x' would return [pf1 x]."); Vfunction_key_map = Fmake_sparse_keymap (Qnil); --- 2244,2255 ---- function-key-map with their bindings. When the current local and global\n\ keymaps have no binding for the current key sequence but\n\ ! function-key-map binds a suffix of the sequence to a vector or string,\n\ read-key-sequence replaces the matching suffix with its binding, and\n\ continues with the new sequence.\n\ \n\ ! For example, suppose function-key-map binds `ESC O P' to [f1].\n\ ! Typing `ESC O P' to read-key-sequence would return [f1]. Typing\n\ ! `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\ ! key, typing `ESC O P x' would return [f1 x]."); Vfunction_key_map = Fmake_sparse_keymap (Qnil); diff -rc2P --exclude-from=exceptions emacs-19.16/src/lisp.h emacs-19.17/src/lisp.h *** emacs-19.16/src/lisp.h Sat Jun 19 16:24:44 1993 --- emacs-19.17/src/lisp.h Sun Jul 18 02:07:46 1993 *************** *** 448,454 **** struct interval *left; /* Intervals which precede me. */ struct interval *right; /* Intervals which succeed me. */ - struct interval *parent; /* Parent in the tree, or the Lisp_Object - containing this interval tree. */ /* The remaining components are `properties' of the interval. The first four are duplicates for things which can be on the list, --- 448,464 ---- struct interval *left; /* Intervals which precede me. */ struct interval *right; /* Intervals which succeed me. */ + /* Parent in the tree, or the Lisp_Object containing this interval tree. + + The mark bit on the root interval of an interval tree says + whether we have started (and possibly finished) marking the + tree. If GC comes across an interval tree whose root's parent + field has its markbit set, it leaves the tree alone. + + You'd think we could store this information in the parent object + somewhere (after all, that should be visited once and then + ignored too, right?), but strings are GC'd strangely. */ + struct interval *parent; + /* The remaining components are `properties' of the interval. The first four are duplicates for things which can be on the list, *************** *** 461,465 **** unsigned char rear_sticky; /* Likewise for just after it. */ ! Lisp_Object plist; /* Properties of this interval. */ }; --- 471,479 ---- unsigned char rear_sticky; /* Likewise for just after it. */ ! /* Properties of this interval. ! The mark bit on this field says whether this particular interval ! tree node has been visited. Since intervals should never be ! shared, GC aborts if it seems to have visited an interval twice. */ ! Lisp_Object plist; }; *************** *** 981,984 **** --- 995,999 ---- extern Lisp_Object Qend_of_file, Qarith_error; extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; + extern Lisp_Object Qmark_inactive; extern Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error; *************** *** 1287,1290 **** --- 1302,1309 ---- extern Lisp_Object Fundo_boundary (); extern Lisp_Object truncate_undo_list (); + + /* defined in textprop.c */ + extern Lisp_Object Qmodification_hooks; + extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks; /* Nonzero means Emacs has already been initialized. diff -rc2P --exclude-from=exceptions emacs-19.16/src/m/dpx2.h emacs-19.17/src/m/dpx2.h *** emacs-19.16/src/m/dpx2.h --- emacs-19.17/src/m/dpx2.h Wed Jul 14 02:09:50 1993 *************** *** 0 **** --- 1,244 ---- + /* machine description for Bull DPX/2 range + Copyright (C) 1985, 1986 Free Software Foundation, Inc. + + This file is part of GNU Emacs. + + GNU Emacs is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 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. */ + + /* The following line tells the configuration script what sort of + operating system this machine is likely to run. + USUAL-OPSYS="usg5-3" */ + + /* + * You need to either un-comment one of these lines, or copy one + * of them to config.h before you include this file. + * Note that some simply define a constant and others set a value. + */ + + /* #define ncl_el /* DPX/2 210,220 etc */ + /* #define ncl_mr 1 /* DPX/2 320,340 (and 360,380 ?) */ + + /* The following three symbols give information on + the size of various data types. */ + + #define SHORTBITS 16 /* Number of bits in a short */ + + #define INTBITS 32 /* Number of bits in an int */ + + #define LONGBITS 32 /* Number of bits in a long */ + + /* Define BIG_ENDIAN iff lowest-numbered byte in a word + is the most significant byte. */ + + #define BIG_ENDIAN + + /* Define NO_ARG_ARRAY if you cannot take the address of the first of a + * group of arguments and treat it as an array of the arguments. */ + + #define NO_ARG_ARRAY + + /* Define WORD_MACHINE if addresses and such have + * to be corrected before they can be used as byte counts. */ + + /* #define WORD_MACHINE /**/ + + /* Now define a symbol for the cpu type, if your compiler + does not define it automatically: + Ones defined so far include vax, m68000, ns16000, pyramid, + orion, tahoe, APOLLO and many others */ + + /* /bin/cc on ncl_el and ncl_mr define m68k and mc68000 */ + + /* Use type int rather than a union, to represent Lisp_Object */ + /* This is desirable for most machines. */ + + #define NO_UNION_TYPE + + /* Define EXPLICIT_SIGN_EXTEND if XINT must explicitly sign-extend + the 24-bit bit field into an int. In other words, if bit fields + are always unsigned. + + If you use NO_UNION_TYPE, this flag does not matter. */ + + #define EXPLICIT_SIGN_EXTEND + + /* Data type of load average, as read out of kmem. */ + + #define LOAD_AVE_TYPE long + + /* Convert that into an integer that is 100 for a load average of 1.0 */ + + #define FSCALE 1000.0 + #define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) + + /* Define CANNOT_DUMP on machines where unexec does not work. + Then the function dump-emacs will not be defined + and temacs will do (load "loadup") automatically unless told otherwise. */ + + /*#define CANNOT_DUMP /**/ + + /* Define VIRT_ADDR_VARIES if the virtual addresses of + pure and impure space as loaded can vary, and even their + relative order cannot be relied on. + + Otherwise Emacs assumes that text space precedes data space, + numerically. */ + + /* #define VIRT_ADDR_VARIES /**/ + + /* Define C_ALLOCA if this machine does not support a true alloca + and the one written in C should be used instead. + Define HAVE_ALLOCA to say that the system provides a properly + working alloca function and it should be used. + Define neither one if an assembler-language alloca + in the file alloca.s should be used. */ + + #define C_ALLOCA + /* #define HAVE_ALLOCA /**/ + + /* Define NO_REMAP if memory segmentation makes it not work well + to change the boundary between the text section and data section + when Emacs is dumped. If you define this, the preloaded Lisp + code will not be sharable; but that's better than failing completely. */ + + #define NO_REMAP + + /* + * end of the standard macro's + */ + + /* + * a neat identifier to handle source mods (if needed) + */ + #ifndef DPX2 + #define DPX2 + #endif + + /* Disable support for shared libraries in unexec. */ + + #undef USG_SHARED_LIBRARIES + + /* + * if we use X11, libX11.a has these... + */ + #ifdef HAVE_X_WINDOWS + # undef LIB_X11_LIB + # define LIB_X11_LIB -lX11 + # undef LIBX11_SYSTEM + # define LIBX11_SYSTEM -lmalloc -lnsl + # define BSTRING + # define HAVE_GETWD + + /* + * we must have INET loaded so we have sockets + */ + # define HAVE_SOCKETS + #endif /* HAVE_X_WINDOWS */ + + /* + * useful if you have INET loaded + */ + #ifdef HAVE_SOCKETS + # define LIBS_MACHINE -linet + #endif + + + #if (defined(ncl_mr) || defined(ncl_el)) && !defined (NBPC) + # define NBPC 4096 + #endif + + /* + * if SIGIO is defined, much of the emacs + * code assumes we are BSD !! + */ + #ifdef SIGIO + # undef SIGIO + #endif + + + /* + * a good idea on multi-user systems :-) + */ + #define CLASH_DETECTION /* probably a good idea */ + + + #ifdef SIGTSTP + /* + * sysdep.c(sys_suspend) works fine with emacs-18.58 + * and BOS 02.00.45, if you have an earler version + * of Emacs and/or BOS, or have problems, or just prefer + * to start a sub-shell rather than suspend-emacs, + * un-comment out the next line. + */ + # undef SIGTSTP /* make suspend-emacs spawn a sub-shell */ + # ifdef NOMULTIPLEJOBS + # undef NOMULTIPLEJOBS + # endif + #endif + /* + * no we don't want this at all + */ + #ifdef USG_JOBCTRL + # undef USG_JOBCTRL + #endif + + /* + * but we have that + */ + #define GETPGRP_NO_ARG + + /* + * X support _needs_ this + */ + #define HAVE_SELECT + /* + * and select requires these + */ + #define HAVE_TIMEVAL + #define USE_UTIME + + /* select also needs this header file--but not in ymakefile. */ + #ifndef NOT_C_CODE + #include + #include + #endif + + #define TEXT_START 0 + + /* + * Define the direction of stack growth. + */ + + #define STACK_DIRECTION -1 + + /* we have termios */ + #undef HAVE_TERMIO + #define HAVE_TERMIOS + + /* we also have this */ + #define HAVE_PTYS + #define SYSV_PTYS + + /* It doesn't seem we have sigpause */ + #undef HAVE_SYSV_SIGPAUSE + + + /* on bos2.00.45 there is a bug that makes the F_SETOWN fcntl() call + enters in an infinite loop. Avoid calling it */ + #define F_SETOWN_BUG + + /* end of dpx2.h */ + + diff -rc2P --exclude-from=exceptions emacs-19.16/src/minibuf.c emacs-19.17/src/minibuf.c *** emacs-19.16/src/minibuf.c Fri Jun 18 11:05:42 1993 --- emacs-19.17/src/minibuf.c Tue Jul 13 17:03:08 1993 *************** *** 1250,1254 **** if (NILP (completions)) ! write_string ("There are no possible completions of what you have typed.", -1); else { --- 1250,1255 ---- if (NILP (completions)) ! write_string ("There are no possible completions of what you have typed.", ! -1); else { *************** *** 1305,1308 **** --- 1306,1312 ---- } } + + if (!NILP (Vrun_hooks)) + call1 (Vrun_hooks, intern ("completion-setup-hook")); if (XTYPE (Vstandard_output) == Lisp_Buffer) diff -rc2P --exclude-from=exceptions emacs-19.16/src/print.c emacs-19.17/src/print.c *** emacs-19.16/src/print.c Tue Jul 6 03:33:02 1993 --- emacs-19.17/src/print.c Sun Jul 18 02:07:51 1993 *************** *** 611,616 **** double data; { ! register unsigned char *cp, c; ! register int width; if (NILP (Vfloat_output_format) --- 611,616 ---- double data; { ! unsigned char *cp; ! int width = -1; if (NILP (Vfloat_output_format) *************** *** 631,646 **** cp += 2; - for (width = 0; - ((c = *cp) >= '0' && c <= '9'); - cp++) - { - width *= 10; - width += c - '0'; - } if (*cp != 'e' && *cp != 'f' && *cp != 'g') goto lose; ! if (width < (*cp != 'e') || width > DBL_DIG) goto lose; --- 631,648 ---- cp += 2; + /* Check the width specification. */ + if ('0' <= *cp && *cp <= '9') + for (width = 0; (*cp >= '0' && *cp <= '9'); cp++) + width = (width * 10) + (*cp - '0'); + if (*cp != 'e' && *cp != 'f' && *cp != 'g') goto lose; ! /* A precision of zero is valid for %f; everything else requires ! at least one. Width may be omitted anywhere. */ ! if (width != -1 ! && (width < (*cp != 'f') ! || width > DBL_DIG)) goto lose; *************** *** 651,671 **** } ! /* Make sure there is a decimal point with digit after, or an exponent, ! so that the value is readable as a float. */ ! for (cp = buf; *cp; cp++) ! if ((*cp < '0' || *cp > '9') && *cp != '-') ! break; ! ! if (*cp == '.' && cp[1] == 0) { ! cp[1] = '0'; ! cp[2] = 0; ! } ! if (*cp == 0) ! { ! *cp++ = '.'; ! *cp++ = '0'; ! *cp++ = 0; } } --- 653,678 ---- } ! /* Make sure there is a decimal point with digit after, or an ! exponent, so that the value is readable as a float. But don't do ! this with "%.0f"; it's legal for that not to produce a decimal ! point. */ ! if (*cp != 'f' || width != 0) { ! for (cp = buf; *cp; cp++) ! if ((*cp < '0' || *cp > '9') && *cp != '-') ! break; ! if (*cp == '.' && cp[1] == 0) ! { ! cp[1] = '0'; ! cp[2] = 0; ! } ! ! if (*cp == 0) ! { ! *cp++ = '.'; ! *cp++ = '0'; ! *cp++ = 0; ! } } } *************** *** 1031,1035 **** The precision in any of these cases is the number of digits following\n\ the decimal point. With `f', a precision of 0 means to omit the\n\ ! decimal point. 0 is not allowed with `f' or `g'.\n\n\ A value of nil means to use `%.20g'."); Vfloat_output_format = Qnil; --- 1038,1042 ---- The precision in any of these cases is the number of digits following\n\ the decimal point. With `f', a precision of 0 means to omit the\n\ ! decimal point. 0 is not allowed with `e' or `g'.\n\n\ A value of nil means to use `%.20g'."); Vfloat_output_format = Qnil; diff -rc2P --exclude-from=exceptions emacs-19.16/src/process.c emacs-19.17/src/process.c *** emacs-19.16/src/process.c Fri Jul 2 01:38:54 1993 --- emacs-19.17/src/process.c Fri Jul 9 17:41:38 1993 *************** *** 1881,1885 **** to give it higher priority than subprocesses */ ! if (XINT (read_kbd) && detect_input_pending ()) { swallow_events (); --- 1881,1886 ---- to give it higher priority than subprocesses */ ! if ((XINT (read_kbd) || wait_for_cell) ! && detect_input_pending ()) { swallow_events (); *************** *** 1907,1911 **** /* If checking input just got us a size-change event from X, obey it now if we should. */ ! if (XINT (read_kbd)) do_pending_window_change (); --- 1908,1912 ---- /* If checking input just got us a size-change event from X, obey it now if we should. */ ! if (XINT (read_kbd) || wait_for_cell) do_pending_window_change (); diff -rc2P --exclude-from=exceptions emacs-19.16/src/s/hpux9.h emacs-19.17/src/s/hpux9.h *** emacs-19.16/src/s/hpux9.h Mon Jun 7 14:05:13 1993 --- emacs-19.17/src/s/hpux9.h Sun Jul 18 02:09:19 1993 *************** *** 5,10 **** #define HPUX9 #if 0 - /* Try some debugging and see if gnu malloc hurts us */ #define SYSTEM_MALLOC 1 #undef GNU_MALLOC --- 5,12 ---- #define HPUX9 + /* If Emacs doesn't seem to work when built to use GNU malloc, you + probably need to get the latest patches to the HP/UX compiler. + See `etc/MACHINES' for more information. */ #if 0 #define SYSTEM_MALLOC 1 #undef GNU_MALLOC diff -rc2P --exclude-from=exceptions emacs-19.16/src/syntax.c emacs-19.17/src/syntax.c *** emacs-19.16/src/syntax.c Thu Jun 17 00:07:43 1993 --- emacs-19.17/src/syntax.c Sun Jul 18 02:07:59 1993 *************** *** 231,235 **** due to limits in the Unix cpp. ! DEFUN ("modify-syntax-entry", foo, bar, 0, 0, 0, "Set syntax for character CHAR according to string S.\n\ The syntax is changed only for table TABLE, which defaults to\n\ --- 231,235 ---- due to limits in the Unix cpp. ! DEFUN ("modify-syntax-entry", foo, bar, 2, 3, 0, "Set syntax for character CHAR according to string S.\n\ The syntax is changed only for table TABLE, which defaults to\n\ *************** *** 264,268 **** such characters are treated as whitespace when they occur\n\ between expressions.") ! */ --- 264,268 ---- such characters are treated as whitespace when they occur\n\ between expressions.") ! (char, s, table) */ diff -rc2P --exclude-from=exceptions emacs-19.16/src/sysdep.c emacs-19.17/src/sysdep.c *** emacs-19.16/src/sysdep.c Tue Jul 6 02:30:48 1993 --- emacs-19.17/src/sysdep.c Sun Jul 18 02:08:09 1993 *************** *** 966,972 **** --- 966,974 ---- #endif + #ifndef F_SETOWN_BUG #ifdef F_SETOWN int old_fcntl_owner; #endif /* F_SETOWN */ + #endif /* F_SETOWN_BUG */ /* This may also be defined in stdio, *************** *** 1227,1230 **** --- 1229,1233 ---- #ifdef F_SETFL + #ifndef F_SETOWN_BUG #ifdef F_GETOWN /* F_SETFL does not imply existence of F_GETOWN */ if (interrupt_input) *************** *** 1235,1238 **** --- 1238,1242 ---- } #endif /* F_GETOWN */ + #endif /* F_SETOWN_BUG */ #endif /* F_SETFL */ *************** *** 1376,1379 **** --- 1380,1384 ---- #ifdef F_SETFL + #ifndef F_SETOWN_BUG #ifdef F_SETOWN /* F_SETFL does not imply existence of F_SETOWN */ if (interrupt_input) *************** *** 1383,1386 **** --- 1388,1392 ---- } #endif /* F_SETOWN */ + #endif /* F_SETOWN_BUG */ #endif /* F_SETFL */ #ifdef BSD4_1 diff -rc2P --exclude-from=exceptions emacs-19.16/src/termhooks.h emacs-19.17/src/termhooks.h *** emacs-19.16/src/termhooks.h Mon Jun 21 22:02:22 1993 --- emacs-19.17/src/termhooks.h Sun Jul 18 02:08:13 1993 *************** *** 189,193 **** are prepared to handle lispy things. XINT is defined iff lisp.h has been included before this file. */ ! #ifdef XINT enum event_kind --- 189,193 ---- are prepared to handle lispy things. XINT is defined iff lisp.h has been included before this file. */ ! #ifdef CONSP enum event_kind diff -rc2P --exclude-from=exceptions emacs-19.16/src/textprop.c emacs-19.17/src/textprop.c *** emacs-19.16/src/textprop.c Tue Jul 6 10:32:49 1993 --- emacs-19.17/src/textprop.c Sun Jul 18 02:08:18 1993 *************** *** 45,48 **** --- 45,50 ---- Lisp_Object Qpoint_entered; Lisp_Object Qmodification_hooks; + Lisp_Object Qinsert_in_front_hooks; + Lisp_Object Qinsert_behind_hooks; Lisp_Object Qcategory; Lisp_Object Qlocal_map; *************** *** 277,283 **** if (! EQ (property_value (properties, XCONS (sym)->car), XCONS (value)->car)) ! record_property_change (interval->position, LENGTH (interval), ! XCONS (sym)->car, XCONS (value)->car, ! object); /* For each new property that has no value at all in the old plist, --- 279,290 ---- if (! EQ (property_value (properties, XCONS (sym)->car), XCONS (value)->car)) ! { ! modify_region (XBUFFER (object), ! make_number (interval->position), ! make_number (interval->position + LENGTH (interval))); ! record_property_change (interval->position, LENGTH (interval), ! XCONS (sym)->car, XCONS (value)->car, ! object); ! } /* For each new property that has no value at all in the old plist, *************** *** 287,293 **** sym = XCONS (value)->cdr) if (EQ (property_value (interval->plist, XCONS (sym)->car), Qunbound)) ! record_property_change (interval->position, LENGTH (interval), ! XCONS (sym)->car, Qnil, ! object); } --- 294,305 ---- sym = XCONS (value)->cdr) if (EQ (property_value (interval->plist, XCONS (sym)->car), Qunbound)) ! { ! modify_region (XBUFFER (object), ! make_number (interval->position), ! make_number (interval->position + LENGTH (interval))); ! record_property_change (interval->position, LENGTH (interval), ! XCONS (sym)->car, Qnil, ! object); ! } } *************** *** 339,347 **** if (XTYPE (object) == Lisp_Buffer) { - record_property_change (i->position, LENGTH (i), - sym1, Fcar (this_cdr), object); modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); } --- 351,359 ---- if (XTYPE (object) == Lisp_Buffer) { modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); + record_property_change (i->position, LENGTH (i), + sym1, Fcar (this_cdr), object); } *************** *** 357,365 **** if (XTYPE (object) == Lisp_Buffer) { - record_property_change (i->position, LENGTH (i), - sym1, Qnil, object); modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); } i->plist = Fcons (sym1, Fcons (val1, i->plist)); --- 369,377 ---- if (XTYPE (object) == Lisp_Buffer) { modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); + record_property_change (i->position, LENGTH (i), + sym1, Qnil, object); } i->plist = Fcons (sym1, Fcons (val1, i->plist)); *************** *** 395,404 **** if (XTYPE (object) == Lisp_Buffer) { - record_property_change (i->position, LENGTH (i), - sym, Fcar (Fcdr (current_plist)), - object); modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); } --- 407,416 ---- if (XTYPE (object) == Lisp_Buffer) { modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); + record_property_change (i->position, LENGTH (i), + sym, Fcar (Fcdr (current_plist)), + object); } *************** *** 416,424 **** if (XTYPE (object) == Lisp_Buffer) { - record_property_change (i->position, LENGTH (i), - sym, Fcar (Fcdr (this)), object); modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); } --- 428,436 ---- if (XTYPE (object) == Lisp_Buffer) { modify_region (XBUFFER (object), make_number (i->position), make_number (i->position + LENGTH (i))); + record_property_change (i->position, LENGTH (i), + sym, Fcar (Fcdr (this)), object); } *************** *** 677,681 **** { unchanged = i; ! i = split_interval_right (unchanged, s - unchanged->position + 1); copy_properties (unchanged, i); } --- 689,693 ---- { unchanged = i; ! i = split_interval_right (unchanged, s - unchanged->position); copy_properties (unchanged, i); } *************** *** 701,705 **** /* i doesn't have the properties, and goes past the change limit */ unchanged = i; ! i = split_interval_left (unchanged, len + 1); copy_properties (unchanged, i); add_properties (properties, i, object); --- 713,717 ---- /* i doesn't have the properties, and goes past the change limit */ unchanged = i; ! i = split_interval_left (unchanged, len); copy_properties (unchanged, i); add_properties (properties, i, object); *************** *** 757,766 **** { unchanged = i; ! i = split_interval_right (unchanged, s - unchanged->position + 1); if (LENGTH (i) > len) { copy_properties (unchanged, i); ! i = split_interval_left (i, len + 1); set_properties (props, i, object); return Qt; --- 769,778 ---- { unchanged = i; ! i = split_interval_right (unchanged, s - unchanged->position); if (LENGTH (i) > len) { copy_properties (unchanged, i); ! i = split_interval_left (i, len); set_properties (props, i, object); return Qt; *************** *** 786,790 **** { if (LENGTH (i) > len) ! i = split_interval_left (i, len + 1); if (NULL_INTERVAL_P (prev_changed)) --- 798,802 ---- { if (LENGTH (i) > len) ! i = split_interval_left (i, len); if (NULL_INTERVAL_P (prev_changed)) *************** *** 852,856 **** { unchanged = i; ! i = split_interval_right (unchanged, s - unchanged->position + 1); copy_properties (unchanged, i); } --- 864,868 ---- { unchanged = i; ! i = split_interval_right (unchanged, s - unchanged->position); copy_properties (unchanged, i); } *************** *** 876,880 **** /* i has the properties, and goes past the change limit */ unchanged = i; ! i = split_interval_left (i, len + 1); copy_properties (unchanged, i); remove_properties (props, i, object); --- 888,892 ---- /* i has the properties, and goes past the change limit */ unchanged = i; ! i = split_interval_left (i, len); copy_properties (unchanged, i); remove_properties (props, i, object); *************** *** 888,891 **** --- 900,973 ---- } + DEFUN ("text-property-any", Ftext_property_any, + Stext_property_any, 4, 5, 0, + "Check text from START to END to see if PROP is ever `eq' to VALUE.\n\ + If so, return the position of the first character whose PROP is `eq'\n\ + to VALUE. Otherwise return nil.\n\ + The optional fifth argument, OBJECT, is the string or buffer\n\ + containing the text.") + (start, end, prop, value, object) + Lisp_Object start, end, prop, value, object; + { + register INTERVAL i; + register int e, pos; + + if (NILP (object)) + XSET (object, Lisp_Buffer, current_buffer); + i = validate_interval_range (object, &start, &end, soft); + e = XINT (end); + + while (! NULL_INTERVAL_P (i)) + { + if (i->position >= e) + break; + if (EQ (textget (i->plist, prop), value)) + { + pos = i->position; + if (pos < XINT (start)) + pos = XINT (start); + return make_number (pos - (XTYPE (object) == Lisp_String)); + } + i = next_interval (i); + } + return Qnil; + } + + DEFUN ("text-property-not-all", Ftext_property_not_all, + Stext_property_not_all, 4, 5, 0, + "Check text from START to END to see if PROP is ever not `eq' to VALUE.\n\ + If so, return the position of the first character whose PROP is not\n\ + `eq' to VALUE. Otherwise, return nil.\n\ + The optional fifth argument, OBJECT, is the string or buffer\n\ + containing the text.") + (start, end, prop, value, object) + Lisp_Object start, end, prop, value, object; + { + register INTERVAL i; + register int s, e; + + if (NILP (object)) + XSET (object, Lisp_Buffer, current_buffer); + i = validate_interval_range (object, &start, &end, soft); + if (NULL_INTERVAL_P (i)) + return (NILP (value) || EQ (start, end)) ? Qt : Qnil; + s = XINT (start); + e = XINT (end); + + while (! NULL_INTERVAL_P (i)) + { + if (i->position >= e) + break; + if (! EQ (textget (i->plist, prop), value)) + { + if (i->position > s) + s = i->position; + return make_number (s - (XTYPE (object) == Lisp_String)); + } + i = next_interval (i); + } + return Qnil; + } + #if 0 /* You can use set-text-properties for this. */ *************** *** 920,924 **** if (! NILP (i->plist)) { ! i = split_interval_right (unchanged, s - unchanged->position + 1); i->plist = Qnil; modified++; --- 1002,1006 ---- if (! NILP (i->plist)) { ! i = split_interval_right (unchanged, s - unchanged->position); i->plist = Qnil; modified++; *************** *** 926,930 **** if (LENGTH (i) > len) { ! i = split_interval_right (i, len + 1); copy_properties (unchanged, i); return Qt; --- 1008,1012 ---- if (LENGTH (i) > len) { ! i = split_interval_right (i, len); copy_properties (unchanged, i); return Qt; *************** *** 966,970 **** if (LENGTH (i) > len) ! i = split_interval_left (i, len + 1); if (! NULL_INTERVAL_P (prev_changed)) merge_interval_left (i); --- 1048,1052 ---- if (LENGTH (i) > len) ! i = split_interval_left (i, len); if (! NULL_INTERVAL_P (prev_changed)) merge_interval_left (i); *************** *** 1133,1136 **** --- 1215,1222 ---- staticpro (&Qmodification_hooks); Qmodification_hooks = intern ("modification-hooks"); + staticpro (&Qinsert_in_front_hooks); + Qinsert_in_front_hooks = intern ("insert-in-front-hooks"); + staticpro (&Qinsert_behind_hooks); + Qinsert_behind_hooks = intern ("insert-behind-hooks"); defsubr (&Stext_properties_at); *************** *** 1144,1147 **** --- 1230,1235 ---- defsubr (&Sset_text_properties); defsubr (&Sremove_text_properties); + defsubr (&Stext_property_any); + defsubr (&Stext_property_not_all); /* defsubr (&Serase_text_properties); */ /* defsubr (&Scopy_text_properties); */ diff -rc2P --exclude-from=exceptions emacs-19.16/src/window.c emacs-19.17/src/window.c *** emacs-19.16/src/window.c Thu Jun 17 00:12:07 1993 --- emacs-19.17/src/window.c Sun Jul 18 02:08:27 1993 *************** *** 802,806 **** extern Lisp_Object next_frame (), prev_frame (); ! DEFUN ("next-window", Fnext_window, Snext_window, 0, 3, 0, "Return next window after WINDOW in canonical ordering of windows.\n\ If omitted, WINDOW defaults to the selected window.\n\ --- 802,810 ---- extern Lisp_Object next_frame (), prev_frame (); ! /* This comment supplies the doc string for `next-window', ! for make-docfile to see. We cannot put this in the real DEFUN ! due to limits in the Unix cpp. ! ! DEFUN ("next-window", Ffoo, Sfoo, 0, 3, 0, "Return next window after WINDOW in canonical ordering of windows.\n\ If omitted, WINDOW defaults to the selected window.\n\ *************** *** 825,828 **** --- 829,836 ---- windows, eventually ending up back at the window you started with.\n\ `previous-window' traverses the same cycle, in the reverse order.") + (window, minibuf, all_frames) */ + + DEFUN ("next-window", Fnext_window, Snext_window, 0, 3, 0, + 0) (window, minibuf, all_frames) register Lisp_Object window, minibuf, all_frames; *************** *** 906,910 **** } ! DEFUN ("previous-window", Fprevious_window, Sprevious_window, 0, 3, 0, "Return the window preceeding WINDOW in canonical ordering of windows.\n\ If omitted, WINDOW defaults to the selected window.\n\ --- 914,922 ---- } ! /* This comment supplies the doc string for `previous-window', ! for make-docfile to see. We cannot put this in the real DEFUN ! due to limits in the Unix cpp. ! ! DEFUN ("previous-window", Ffoo, Sfoo, 0, 3, 0, "Return the window preceeding WINDOW in canonical ordering of windows.\n\ If omitted, WINDOW defaults to the selected window.\n\ *************** *** 930,933 **** --- 942,950 ---- windows, eventually ending up back at the window you started with.\n\ `next-window' traverses the same cycle, in the reverse order.") + (window, minibuf, all_frames) */ + + + DEFUN ("previous-window", Fprevious_window, Sprevious_window, 0, 3, 0, + 0) (window, minibuf, all_frames) register Lisp_Object window, minibuf, all_frames; *************** *** 1320,1332 **** DEFUN ("delete-windows-on", Fdelete_windows_on, Sdelete_windows_on, 1, 1, "bDelete windows on (buffer): ", ! "Delete all windows showing BUFFER.") ! (buffer) ! Lisp_Object buffer; { if (!NILP (buffer)) { buffer = Fget_buffer (buffer); CHECK_BUFFER (buffer, 0); ! window_loop (DELETE_BUFFER_WINDOWS, buffer, 0, Qt); } return Qnil; --- 1337,1362 ---- DEFUN ("delete-windows-on", Fdelete_windows_on, Sdelete_windows_on, 1, 1, "bDelete windows on (buffer): ", ! "Delete all windows showing BUFFER.\n\ ! Optional second argument FRAME controls which frames are affected.\n\ ! If nil or omitted, delete all windows showing BUFFER in any frame.\n\ ! If t, delete only windows showing BUFFER in the selected frame.\n\ ! If a frame, delete only windows showing BUFFER in that frame.") ! (buffer, frame) ! Lisp_Object buffer, frame; { + #ifdef MULTI_FRAME + /* FRAME uses t and nil to mean the opposite of what window_loop + expects. */ + if (! FRAMEP (frame)) + frame = NILP (frame) ? Qt : Qnil; + #else + frame = Qt; + #endif + if (!NILP (buffer)) { buffer = Fget_buffer (buffer); CHECK_BUFFER (buffer, 0); ! window_loop (DELETE_BUFFER_WINDOWS, buffer, 0, frame); } return Qnil; diff -rc2P --exclude-from=exceptions emacs-19.16/src/xfns.c emacs-19.17/src/xfns.c *** emacs-19.16/src/xfns.c Wed Jun 30 16:51:46 1993 --- emacs-19.17/src/xfns.c Sun Jul 18 04:06:26 1993 *************** *** 59,64 **** #define EMACS_CLASS "Emacs" ! /* The name we're using for this X application. */ ! Lisp_Object Vxrdb_name; /* Title name and application name for X stuff. */ --- 59,64 ---- #define EMACS_CLASS "Emacs" ! /* The name we're using in resource queries. */ ! Lisp_Object Vx_resource_name; /* Title name and application name for X stuff. */ *************** *** 359,366 **** } ! XSET (width, Lisp_Int, FRAME_WIDTH (f)); ! XSET (height, Lisp_Int, FRAME_HEIGHT (f)); ! XSET (top, Lisp_Int, f->display.x->top_pos); ! XSET (left, Lisp_Int, f->display.x->left_pos); /* Now process them in reverse of specified order. */ --- 359,363 ---- } ! width = height = top = left = Qunbound; /* Now process them in reverse of specified order. */ *************** *** 394,408 **** } ! /* Don't call these unless they've changed; the window may not actually ! exist yet. */ { Lisp_Object frame; XSET (frame, Lisp_Frame, f); ! if (XINT (width) != FRAME_WIDTH (f) ! || XINT (height) != FRAME_HEIGHT (f)) Fset_frame_size (frame, width, height); ! if (XINT (left) != f->display.x->left_pos ! || XINT (top) != f->display.x->top_pos) Fset_frame_position (frame, left, top); } --- 391,411 ---- } ! /* Don't set these parameters these unless they've been explicitly ! specified. The window might be mapped or resized while we're in ! this function, and we don't want to override that unless the lisp ! code has asked for it. ! ! Don't set these parameters unless they actually differ from the ! window's current parameters; the window may not actually exist ! yet. */ { Lisp_Object frame; XSET (frame, Lisp_Frame, f); ! if ((NUMBERP (width) && XINT (width) != FRAME_WIDTH (f)) ! || (NUMBERP (height) && XINT (height) != FRAME_HEIGHT (f))) Fset_frame_size (frame, width, height); ! if ((NUMBERP (left) && XINT (left) != f->display.x->left_pos) ! || (NUMBERP (top) && XINT (top) != f->display.x->top_pos)) Fset_frame_position (frame, left, top); } *************** *** 1099,1102 **** --- 1102,1115 ---- #ifdef HAVE_X11 + + /* Make sure that Vx_resource_name is set to a reasonable value. */ + static void + validate_x_resource_name () + { + if (! STRINGP (Vx_resource_name)) + Vx_resource_name = make_string ("emacs"); + } + + extern char *x_get_string_resource (); extern XrmDatabase x_load_resources (); *************** *** 1104,1113 **** DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0, "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\ ! This uses `INSTANCE.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\ ! class, where INSTANCE is the name under which Emacs was invoked.\n\ \n\ The optional arguments COMPONENT and SUBCLASS add to the key and the\n\ class, respectively. You must specify both of them or neither.\n\ ! If you specify them, the key is `INSTANCE.COMPONENT.ATTRIBUTE'\n\ and the class is `Emacs.CLASS.SUBCLASS'.") (attribute, class, component, subclass) --- 1117,1127 ---- DEFUN ("x-get-resource", Fx_get_resource, Sx_get_resource, 2, 4, 0, "Return the value of ATTRIBUTE, of class CLASS, from the X defaults database.\n\ ! This uses `NAME.ATTRIBUTE' as the key and `Emacs.CLASS' as the\n\ ! class, where INSTANCE is the name under which Emacs was invoked, or\n\ ! the name specified by the `-name' or `-rn' command-line arguments.\n\ \n\ The optional arguments COMPONENT and SUBCLASS add to the key and the\n\ class, respectively. You must specify both of them or neither.\n\ ! If you specify them, the key is `NAME.COMPONENT.ATTRIBUTE'\n\ and the class is `Emacs.CLASS.SUBCLASS'.") (attribute, class, component, subclass) *************** *** 1130,1138 **** error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither"); if (NILP (component)) { /* Allocate space for the components, the dots which separate them, and the final '\0'. */ ! name_key = (char *) alloca (XSTRING (Vxrdb_name)->size + XSTRING (attribute)->size + 2); --- 1144,1154 ---- error ("x-get-resource: must specify both COMPONENT and SUBCLASS or neither"); + validate_x_resource_name (); + if (NILP (component)) { /* Allocate space for the components, the dots which separate them, and the final '\0'. */ ! name_key = (char *) alloca (XSTRING (Vx_resource_name)->size + XSTRING (attribute)->size + 2); *************** *** 1142,1146 **** sprintf (name_key, "%s.%s", ! XSTRING (Vxrdb_name)->data, XSTRING (attribute)->data); sprintf (class_key, "%s.%s", --- 1158,1162 ---- sprintf (name_key, "%s.%s", ! XSTRING (Vx_resource_name)->data, XSTRING (attribute)->data); sprintf (class_key, "%s.%s", *************** *** 1150,1154 **** else { ! name_key = (char *) alloca (XSTRING (Vxrdb_name)->size + XSTRING (component)->size + XSTRING (attribute)->size --- 1166,1170 ---- else { ! name_key = (char *) alloca (XSTRING (Vx_resource_name)->size + XSTRING (component)->size + XSTRING (attribute)->size *************** *** 1161,1165 **** sprintf (name_key, "%s.%s.%s", ! XSTRING (Vxrdb_name)->data, XSTRING (component)->data, XSTRING (attribute)->data); --- 1177,1181 ---- sprintf (name_key, "%s.%s.%s", ! XSTRING (Vx_resource_name)->data, XSTRING (component)->data, XSTRING (attribute)->data); *************** *** 1523,1527 **** attribute_mask, &attributes); ! class_hints.res_name = (char *) XSTRING (Vxrdb_name)->data; class_hints.res_class = EMACS_CLASS; XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints); --- 1539,1544 ---- attribute_mask, &attributes); ! validate_x_resource_name (); ! class_hints.res_name = (char *) XSTRING (Vx_resource_name)->data; class_hints.res_class = EMACS_CLASS; XSetClassHint (x_current_display, FRAME_X_WINDOW (f), &class_hints); *************** *** 1734,1744 **** /* Extract the window parameters from the supplied values that are needed to determine window geometry. */ ! x_default_parameter (f, parms, Qfont, ! build_string ! /* If we use an XLFD name for this font, the lisp code ! knows how to find variants which are bold, italic, ! etcetera. */ ! ("-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1"), ! "font", "Font", string); x_default_parameter (f, parms, Qborder_width, make_number (2), "borderwidth", "BorderWidth", number); --- 1751,1767 ---- /* Extract the window parameters from the supplied values that are needed to determine window geometry. */ ! { ! Lisp_Object font; ! ! /* Try out a font which we know has bold and italic variations. */ ! BLOCK_INPUT; ! font = x_new_font (f, "-*-*-medium-r-*-*-*-*-*-*-c-*-iso8859-1"); ! UNBLOCK_INPUT; ! if (! STRINGP (font)) ! font = build_string ("-*-fixed-*-*-*-*-*-120-*-*-c-*-iso8859-1"); ! ! x_default_parameter (f, parms, Qfont, font, ! "font", "Font", string); ! } x_default_parameter (f, parms, Qborder_width, make_number (2), "borderwidth", "BorderWidth", number); *************** *** 3467,3472 **** DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 2, 0, "Open a connection to an X server.\n\ ! DISPLAY is the name of the display to connect to. Optional second\n\ ! arg XRM_STRING is a string of resources in xrdb format.") (display, xrm_string) Lisp_Object display, xrm_string; --- 3490,3495 ---- DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, 1, 2, 0, "Open a connection to an X server.\n\ ! DISPLAY is the name of the display to connect to.\n\ ! Optional second arg XRM_STRING is a string of resources in xrdb format.") (display, xrm_string) Lisp_Object display, xrm_string; *************** *** 3478,3481 **** --- 3501,3506 ---- if (x_current_display != 0) error ("X server connection is already initialized"); + if (! NILP (xrm_string)) + CHECK_STRING (xrm_string, 1); /* This is what opens the connection and sets x_current_display. *************** *** 3486,3500 **** XFASTINT (Vwindow_system_version) = 11; ! if (!EQ (xrm_string, Qnil)) ! { ! CHECK_STRING (xrm_string, 1); ! xrm_option = (unsigned char *) XSTRING (xrm_string)->data; ! } else xrm_option = (unsigned char *) 0; BLOCK_INPUT; ! xrdb = x_load_resources (x_current_display, xrm_option, EMACS_CLASS); UNBLOCK_INPUT; ! #if defined (HAVE_X11R5) || defined (HAVE_XRMSETDATABASE) XrmSetDatabase (x_current_display, xrdb); #else --- 3511,3527 ---- XFASTINT (Vwindow_system_version) = 11; ! if (! NILP (xrm_string)) ! xrm_option = (unsigned char *) XSTRING (xrm_string)->data; else xrm_option = (unsigned char *) 0; + + validate_x_resource_name (); + BLOCK_INPUT; ! xrdb = x_load_resources (x_current_display, xrm_option, ! (char *) XSTRING (Vx_resource_name)->data, ! EMACS_CLASS); UNBLOCK_INPUT; ! #if defined (HAVE_X11R5) XrmSetDatabase (x_current_display, xrdb); #else *************** *** 3502,3518 **** #endif - /* Make a version of Vinvocation_name suitable for use in xrdb - queries - i.e. containing no dots or asterisks. */ - Vxrdb_name = Fcopy_sequence (Vinvocation_name); - { - int i; - int len = XSTRING (Vxrdb_name)->size; - unsigned char *data = XSTRING (Vxrdb_name)->data; - - for (i = 0; i < len; i++) - if (data[i] == '.' || data[i] == '*') - data[i] = '-'; - } - x_screen = DefaultScreenOfDisplay (x_current_display); --- 3529,3532 ---- *************** *** 3657,3670 **** DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset, ! "The buffer offset of the character under the pointer."); mouse_buffer_offset = 0; DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape, ! "The shape of the pointer when over text.\n\ Changing the value does not affect existing frames\n\ unless you set the mouse color."); Vx_pointer_shape = Qnil; ! staticpro (&Vxrdb_name); #if 0 --- 3671,3692 ---- DEFVAR_INT ("mouse-buffer-offset", &mouse_buffer_offset, ! "The buffer offset of the character under the pointer."); mouse_buffer_offset = 0; DEFVAR_INT ("x-pointer-shape", &Vx_pointer_shape, ! "The shape of the pointer when over text.\n\ Changing the value does not affect existing frames\n\ unless you set the mouse color."); Vx_pointer_shape = Qnil; ! DEFVAR_LISP ("x-resource-name", &Vx_resource_name, ! "The name Emacs uses to look up X resources; for internal use only.\n\ ! `x-get-resource' uses this as the first component of the instance name\n\ ! when requesting resource values.\n\ ! Emacs initially sets `x-resource-name' to the name under which Emacs\n\ ! was invoked, or to the value specified with the `-name' or `-rn'\n\ ! switches, if present."); ! Vx_resource_name = Qnil; ! staticpro (&Vx_resource_name); #if 0 diff -rc2P --exclude-from=exceptions emacs-19.16/src/xrdb.c emacs-19.17/src/xrdb.c *** emacs-19.16/src/xrdb.c Mon Jun 21 23:43:12 1993 --- emacs-19.17/src/xrdb.c Sun Jul 18 02:08:44 1993 *************** *** 22,25 **** --- 22,27 ---- #endif + #include + #if 1 /* I'd really appreciate it if this code could go away... -JimB */ /* this avoids lossage in the `dual-universe' headers on AT&T SysV X11 */ *************** *** 72,82 **** #endif static char * ! gethomedir (dirname) ! char *dirname; { int uid; struct passwd *pw; char *ptr; if ((ptr = getenv ("HOME")) == NULL) --- 74,286 ---- #endif + /* Make sure not to #include anything after these definitions. Let's + not step on anyone's prototypes. */ + #ifdef emacs + #define malloc xmalloc + #define realloc xrealloc + #define free xfree + #endif + + char *x_get_string_resource (); + static int file_p (); + + + /* X file search path processing. */ + + + /* The string which gets substituted for the %C escape in XFILESEARCHPATH + and friends, or zero if none was specified. */ + char *x_customization_string; + + + /* Return the value of the emacs.customization (Emacs.Customization) + resource, for later use in search path decoding. If we find no + such resource, return zero. */ + char * + x_get_customization_string (db, name, class) + XrmDatabase db; + char *name, *class; + { + char *full_name + = (char *) alloca (strlen (name) + sizeof ("customization") + 3); + char *full_class + = (char *) alloca (strlen (class) + sizeof ("Customization") + 3); + char *result; + + sprintf (full_name, "%s.%s", name, "customization"); + sprintf (full_class, "%s.%s", class, "Customization"); + + result = x_get_string_resource (db, full_name, full_class); + + if (result) + return strcpy ((char *) malloc (strlen (result) + 1), result); + else + return 0; + } + + + /* Expand all the Xt-style %-escapes in STRING, whose length is given + by STRING_LEN. Here are the escapes we're supposed to recognize: + + %N The value of the application's class name + %T The value of the type parameter ("app-defaults" in this + context) + %S The value of the suffix parameter ("" in this context) + %L The language string associated with the specified display + (We use the "LANG" environment variable here, if it's set.) + %l The language part of the display's language string + (We treat this just like %L. If someone can tell us what + we're really supposed to do, dandy.) + %t The territory part of the display's language string + (This never gets used.) + %c The codeset part of the display's language string + (This never gets used either.) + %C The customization string retrieved from the resource + database associated with display. + (This is x_customization_string.) + + Return the expanded file name if it exists and is readable, and + refers to %L only when the LANG environment variable is set, or + otherwise provided by X. + + ESCAPED_SUFFIX and SUFFIX are postpended to STRING if they are + non-zero. %-escapes in ESCAPED_SUFFIX are expanded; STRING is left + alone. + + Return NULL otherwise. */ + + static char * + magic_file_p (string, string_len, class, escaped_suffix, suffix) + char *string; + int string_len; + char *class, *escaped_suffix, *suffix; + { + char *lang = getenv ("LANG"); + + int path_size = 100; + char *path = (char *) malloc (path_size); + int path_len = 0; + + char *p = string; + + while (p < string + string_len) + { + /* The chunk we're about to stick on the end of result. */ + char *next; + int next_len; + + if (*p == '%') + { + p++; + + if (p >= string + string_len) + next_len = 0; + else + switch (*p) + { + case '%': + next = "%"; + next_len = 1; + break; + + case 'C': + next = (x_customization_string + ? x_customization_string + : ""); + next_len = strlen (next); + break; + + case 'N': + next = class; + next_len = strlen (class); + break; + + case 'T': + next = "app-defaults"; + next_len = strlen (next); + break; + + default: + case 'S': + next_len = 0; + break; + + case 'L': + case 'l': + if (! lang) + { + free (path); + return NULL; + } + + next = lang; + next_len = strlen (next); + break; + + case 't': + case 'c': + free (path); + return NULL; + } + } + else + next = p, next_len = 1; + + /* Do we have room for this component followed by a '\0' ? */ + if (path_len + next_len + 1 > path_size) + { + path_size = (path_len + next_len + 1) * 2; + path = (char *) realloc (path, path_size); + } + + bcopy (next, path + path_len, next_len); + path_len += next_len; + + p++; + + /* If we've reached the end of the string, append ESCAPED_SUFFIX. */ + if (p >= string + string_len && escaped_suffix) + { + string = escaped_suffix; + string_len = strlen (string); + p = string; + escaped_suffix = NULL; + } + } + + /* Perhaps we should add the SUFFIX now. */ + if (suffix) + { + int suffix_len = strlen (suffix); + + if (path_len + suffix_len + 1 > path_size) + { + path_size = (path_len + suffix_len + 1); + path = (char *) realloc (path, path_size); + } + + bcopy (suffix, path + path_len, suffix_len); + path_len += suffix_len; + } + + path[path_len] = '\0'; + + if (! file_p (path)) + { + free (path); + return NULL; + } + + return path; + } + + static char * ! gethomedir () { int uid; struct passwd *pw; char *ptr; + char *copy; if ((ptr = getenv ("HOME")) == NULL) *************** *** 89,112 **** pw = getpwuid (uid); } if (pw) ptr = pw->pw_dir; - else - { - ptr = NULL; - *dirname = '\0'; - } } ! if (ptr != NULL) ! strcpy (dirname, ptr); ! dirname += strlen (dirname); ! *dirname = '/'; ! dirname++; ! *dirname = '\0'; ! return dirname; } static int file_p (path) --- 293,312 ---- pw = getpwuid (uid); } + if (pw) ptr = pw->pw_dir; } ! if (ptr == NULL) ! return "/"; ! copy = (char *) malloc (strlen (ptr) + 2); ! strcpy (copy, ptr); ! strcat (copy, "/"); ! return copy; } + static int file_p (path) *************** *** 120,199 **** } - #if 0 - #define X_DEFAULT_SEARCH_PATH "/usr/lib/X11/" - #endif - - /* Isn't this just disgusting? */ - - #define X_DEFAULT_SEARCH_PATH "/usr/lib/X11/%L/%T/%N%S:/usr/lib/X11/%l/%T/%N%S:/usr/lib/X11/%T/%N%S" - - static int - decode_magic (string, file, return_path) - char *string, *file, *return_path; - { - char *p = string; - char *t = return_path; - - while (*p) - { - if (*p == '%') - switch (*++p) - { - case '%': - *t++ = '%'; - p++; - break; - - case 'N': - case 'T': - case 'S': - case 'L': - case 'l': - case 't': - case 'c': - default: - p++; - if (*t == '/' && *p == '/') - p++; - break; - } - else - *t++ = *p++; - } - *t = '\0'; - strcat (return_path, file); - - if (file_p (return_path)) - return 1; ! return_path[0] = '\0'; ! return 0; ! } ! static int ! magic_searchpath_decoder (incantation_string, file, return_path) ! char *incantation_string, *return_path, *file; { ! register char *s = incantation_string; ! register char *p; ! /* Must be big enough for "%N%S". */ ! register int string_size = MAXPATHLEN; ! register char *string = (char *) alloca (string_size * sizeof (*string)); ! ! while (*s) { ! p = s; ! ! while (*p && *p != ':') ! p++; ! if (*p == ':' && *(p + 1) == ':') { ! /* We know string is big enough for this. */ ! bcopy ("%N%S", string, 5); ! if (decode_magic (string, file, return_path)) ! return 1; s = p + 1; continue; --- 320,348 ---- } ! /* Find the first element of SEARCH_PATH which exists and is readable, ! after expanding the %-escapes. Return 0 if we didn't find any, and ! the path name of the one we found otherwise. */ ! static char * ! search_magic_path (search_path, class, escaped_suffix, suffix) ! char *search_path, *class, *escaped_suffix, *suffix; { ! register char *s, *p; ! for (s = search_path; *s; s = p) { ! for (p = s; *p && *p != ':'; p++) ! ; ! if (*p == ':' && *(p + 1) == ':') { ! char *path; + s = "%N%S"; + path = magic_file_p (s, strlen (s), class, escaped_suffix, suffix); + if (path) + return path; + s = p + 1; continue; *************** *** 202,222 **** if (p > s) { ! int len = p - s; ! ! if (string_size < len+1) ! { ! string_size = 2 * len; ! string = (char *) alloca (string_size * sizeof (*string)); ! } ! bcopy (s, string, len); ! string[len] = '\0'; ! if (decode_magic (string, file, return_path)) ! return 1; } ! if (p && *p != 0) ! s = p + 1; ! else ! return 0; } --- 351,361 ---- if (p > s) { ! char *path = magic_file_p (s, p - s, class, escaped_suffix, suffix); ! if (path) ! return path; } ! if (*p == ':') ! p++; } *************** *** 224,245 **** } static XrmDatabase get_system_app (class) char *class; { ! XrmDatabase db; ! char path[MAXPATHLEN]; ! char *p; ! if ((p = getenv ("XFILESEARCHPATH")) == NULL) ! p = X_DEFAULT_SEARCH_PATH; ! if (! magic_searchpath_decoder (p, class, path)) ! return NULL; - db = XrmGetFileDatabase (path); return db; } static XrmDatabase get_fallback (display) --- 363,391 ---- } + /* Producing databases for individual sources. */ + + #define X_DEFAULT_SEARCH_PATH "/usr/lib/X11/%L/%T/%N%C%S:/usr/lib/X11/%l/%T/%N%C%S:/usr/lib/X11/%T/%N%C%S:/usr/lib/X11/%L/%T/%N%S:/usr/lib/X11/%l/%T/%N%S:/usr/lib/X11/%T/%N%S" + static XrmDatabase get_system_app (class) char *class; { ! XrmDatabase db = NULL; ! char *path; ! path = getenv ("XFILESEARCHPATH"); ! if (! path) path = X_DEFAULT_SEARCH_PATH; ! path = search_magic_path (path, class, 0, 0); ! if (path) ! { ! db = XrmGetFileDatabase (path); ! free (path); ! } return db; } + static XrmDatabase get_fallback (display) *************** *** 251,294 **** } static XrmDatabase get_user_app (class) char *class; { ! XrmDatabase db; ! char *magic_path; ! char path[MAXPATHLEN]; ! if ((magic_path = getenv ("XUSERFILESEARCHPATH")) == NULL) { ! char homedir[MAXPATHLEN]; ! char *default_magic; ! char *p; ! ! gethomedir (homedir); ! ! if ((p = getenv ("XAPPLRESDIR")) == NULL) ! { ! default_magic = "%s/%%L/%%N:%s/%%l/%%N:%s/%%N"; ! magic_path = (char *) alloca ((3 * strlen (homedir)) ! + strlen (default_magic)); ! sprintf (magic_path, default_magic, homedir, homedir, homedir); ! } ! else ! { ! default_magic = "%s/%%L/%%N:%s/%%l/%%N:%s/%%N:%s/%%N"; ! magic_path = (char *) alloca ((3 * strlen (p)) ! + strlen (default_magic) ! + strlen (homedir)); ! sprintf (magic_path, default_magic, p, p, p, homedir); ! } } ! ! if (! magic_searchpath_decoder (magic_path, class, path)) return NULL; - - db = XrmGetFileDatabase (path); - return db; } static XrmDatabase get_user_db (display) --- 397,434 ---- } + static XrmDatabase get_user_app (class) char *class; { ! char *path; ! char *file = 0; ! /* Check for XUSERFILESEARCHPATH. It is a path of complete file ! names, not directories. */ ! if (((path = getenv ("XUSERFILESEARCHPATH")) ! && (file = search_magic_path (path, class, 0, 0))) ! ! /* Check for APPLRESDIR; it is a path of directories. In each, ! we have to search for LANG/CLASS and then CLASS. */ ! || ((path = getenv ("XAPPLRESDIR")) ! && ((file = search_magic_path (path, class, "/%L/%N", 0)) ! || (file = search_magic_path (path, class, "/%N", 0)))) ! ! /* Check in the home directory. This is a bit of a hack; let's ! hope one's home directory doesn't contain any %-escapes. */ ! || (path = gethomedir (), ! ((file = search_magic_path (path, class, "%L/%N", 0)) ! || (file = search_magic_path (path, class, "%N", 0))))) { ! XrmDatabase db = XrmGetFileDatabase (file); ! free (file); ! return db; } ! else return NULL; } + static XrmDatabase get_user_db (display) *************** *** 308,316 **** else { ! char xdefault[MAXPATHLEN]; ! gethomedir (xdefault); strcat (xdefault, ".Xdefaults"); db = XrmGetFileDatabase (xdefault); } --- 448,461 ---- else { ! char *home; ! char *xdefault; ! home = gethomedir (); ! xdefault = (char *) malloc (strlen (home) + sizeof (".Xdefaults")); ! strcpy (xdefault, home); strcat (xdefault, ".Xdefaults"); db = XrmGetFileDatabase (xdefault); + free (home); + free (xdefault); } *************** *** 335,352 **** XrmDatabase db; char *p; ! char path[MAXPATHLEN]; if ((p = getenv ("XENVIRONMENT")) == NULL) { ! gethomedir (path); ! strcat (path, ".Xdefaults-"); ! gethostname (path + strlen (path), MAXPATHLEN - strlen (path)); p = path; } db = XrmGetFileDatabase (p); return db; } /* Types of values that we can find in a database */ --- 480,521 ---- XrmDatabase db; char *p; ! char *path = 0, *home = 0, *host = 0; if ((p = getenv ("XENVIRONMENT")) == NULL) { ! home = gethomedir (); ! ! { ! int host_size = 100; ! host = (char *) malloc (host_size); ! ! for (;;) ! { ! host[host_size - 1] = '\0'; ! gethostname (host, host_size - 1); ! if (strlen (host) < host_size - 1) ! break; ! host = (char *) realloc (host, host_size *= 2); ! } ! } ! ! path = (char *) malloc (strlen (home) ! + sizeof (".Xdefaults-") ! + strlen (host)); ! sprintf (path, "%s%s%s", home, ".Xdefaults-", host); p = path; } db = XrmGetFileDatabase (p); + + if (path) free (path); + if (home) free (home); + if (host) free (host); + return db; } + /* External interface. */ + /* Types of values that we can find in a database */ *************** *** 357,365 **** XrmDatabase ! x_load_resources (display, xrm_string, myclass) Display *display; ! char *xrm_string, *myclass; { char *xdefs; XrmDatabase rdb; XrmDatabase db; --- 526,535 ---- XrmDatabase ! x_load_resources (display, xrm_string, myname, myclass) Display *display; ! char *xrm_string, *myname, *myclass; { char *xdefs; + XrmDatabase user_database; XrmDatabase rdb; XrmDatabase db; *************** *** 369,372 **** --- 539,551 ---- rdb = XrmGetStringDatabase (""); + user_database = get_user_db (display); + + /* Figure out what the "customization string" is, so we can use it + to decode paths. */ + if (x_customization_string) + free (x_customization_string); + x_customization_string + = x_get_customization_string (user_database, myname, myclass); + /* Get application system defaults */ db = get_system_app (myclass); *************** *** 385,391 **** /* get User defaults */ ! db = get_user_db (display); ! if (db != NULL) ! XrmMergeDatabases (db, &rdb); /* Get Environment defaults. */ --- 564,569 ---- /* get User defaults */ ! if (user_database != NULL) ! XrmMergeDatabases (user_database, &rdb); /* Get Environment defaults. */ *************** *** 405,408 **** --- 583,587 ---- } + /* Retrieve the value of the resource specified by NAME with class CLASS and of type TYPE from database RDB. The value is returned in RET_VALUE. */ *************** *** 453,460 **** } #ifdef TESTRM ! #include ! #include "arg-list.h" static void fatal (msg, prog, x1, x2, x3, x4, x5) --- 632,660 ---- } + /* Stand-alone test facilities. */ + #ifdef TESTRM ! ! typedef char **List; ! #define arg_listify(len, list) (list) ! #define car(list) (*(list)) ! #define cdr(list) (list + 1) ! #define NIL(list) (! *(list)) ! #define free_arglist(list) ! ! static List ! member (elt, list) ! char *elt; ! List list; ! { ! List p; ! ! for (p = list; ! NIL (p); p = cdr (p)) ! if (! strcmp (elt, car (p))) ! return p; + return p; + } + static void fatal (msg, prog, x1, x2, x3, x4, x5) *************** *** 476,482 **** { Display *display; ! char *displayname, *resource_string, *class; XrmDatabase xdb; ! List *arg_list, *lp; arg_list = arg_listify (argc, argv); --- 676,682 ---- { Display *display; ! char *displayname, *resource_string, *class, *name; XrmDatabase xdb; ! List arg_list, lp; arg_list = arg_listify (argc, argv); *************** *** 500,529 **** class = "Emacs"; ! free_arglist (arg_list); ! if (!(display = XOpenDisplay (displayname))) fatal ("Can't open display '%s'\n", XDisplayName (displayname)); ! xdb = x_load_resources (display, resource_string, class); - #if 0 /* In a real program, you'd want to also do this: */ display->db = xdb; - #endif while (1) { ! char line[90]; ! printf ("String: "); ! gets (line); ! if (strlen (line)) { ! char *value = x_get_string_resource (xdb, line, class); if (value != NULL) ! printf ("\t%s: %s\n\n", line, value); else printf ("\tNo Value.\n\n"); --- 700,738 ---- class = "Emacs"; ! lp = member ("-n", arg_list); ! if (! NIL (lp)) ! name = car (cdr (lp)); ! else ! name = "emacs"; + free_arglist (arg_list); if (!(display = XOpenDisplay (displayname))) fatal ("Can't open display '%s'\n", XDisplayName (displayname)); ! xdb = x_load_resources (display, resource_string, name, class); /* In a real program, you'd want to also do this: */ display->db = xdb; while (1) { ! char query_name[90]; ! char query_class[90]; ! ! printf ("Name: "); ! gets (query_name); ! if (strlen (query_name)) { ! char *value; ! ! printf ("Class: "); ! gets (query_class); ! ! value = x_get_string_resource (xdb, query_name, query_class); if (value != NULL) ! printf ("\t%s(%s): %s\n\n", query_name, query_class, value); else printf ("\tNo Value.\n\n"); diff -rc2P --exclude-from=exceptions emacs-19.16/src/xterm.c emacs-19.17/src/xterm.c *** emacs-19.16/src/xterm.c Fri Jul 2 00:00:29 1993 --- emacs-19.17/src/xterm.c Sun Jul 18 02:08:58 1993 *************** *** 2862,2866 **** ("withdrawn"); all it does is switch between visible and iconified. Frames get into the invisible state ! only through x_make_frame_invisible. if (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f)) f->async_iconified = 1; --- 2862,2866 ---- ("withdrawn"); all it does is switch between visible and iconified. Frames get into the invisible state ! only through x_make_frame_invisible. */ if (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f)) f->async_iconified = 1; *************** *** 4708,4714 **** --- 4708,4716 ---- Lisp_Object frame; char *defaultvalue; + #ifndef F_SETOWN_BUG #ifdef F_SETOWN extern int old_fcntl_owner; #endif /* ! defined (F_SETOWN) */ + #endif /* F_SETOWN_BUG */ x_focus_frame = x_highlight_frame = 0; *************** *** 4716,4720 **** x_current_display = XOpenDisplay (display_name); if (x_current_display == 0) ! fatal ("X server %s not responding; check the DISPLAY environment variable or use \"-d\"\n", display_name); --- 4718,4723 ---- x_current_display = XOpenDisplay (display_name); if (x_current_display == 0) ! fatal ("X server %s not responding.\n\ ! Check the DISPLAY environment variable or use \"-d\"\n", display_name); *************** *** 4781,4784 **** --- 4784,4788 ---- #endif /* ! defined (HAVE_X11) */ + #ifndef F_SETOWN_BUG #ifdef F_SETOWN old_fcntl_owner = fcntl (0, F_GETOWN, 0); *************** *** 4789,4792 **** --- 4793,4797 ---- #endif /* ! defined (F_SETOWN_SOCK_NEG) */ #endif /* ! defined (F_SETOWN) */ + #endif /* F_SETOWN_BUG */ #ifdef SIGIO diff -rc2P --exclude-from=exceptions emacs-19.16/src/ymakefile emacs-19.17/src/ymakefile *** emacs-19.16/src/ymakefile Tue Jul 6 12:26:33 1993 --- emacs-19.17/src/ymakefile Sun Jul 18 02:09:03 1993 *************** *** 28,31 **** --- 28,32 ---- cppdir = $(dot)$(dot)/cpp/ oldXMenudir = $(dot)$(dot)/oldXMenu/ + config_h = ${srcdir}/config.h /* just to be sure the sh is used */ *************** *** 722,727 **** --- 723,736 ---- /* The files of Lisp proper */ + /* We're trying to track down what we suspect is a hardware problem on + one of our machines. This should expand to the argument + -DDEBUG_MOLE on mole.gnu.ai.mit.edu, and to the empty string on all + other machines. */ + DEBUG_MOLE=`("${srcdir}/gnu-hp300") 2>/dev/null` + alloc.o : alloc.c frame.h window.h buffer.h puresize.h syssignal.h \ blockinput.h $(config_h) INTERVAL_SRC + $(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) ${DEBUG_MOLE} $< + bytecode.o : bytecode.c buffer.h $(config_h) data.o : data.c buffer.h puresize.h syssignal.h $(config_h) \end-of-emacs-patch-kit # Generate the GNUS info files. (cd man; makeinfo gnus.texi)